@@ -803,15 +803,20 @@ We draw from a modified "demo 1" DGP
803
803
804
804
``` {r}
805
805
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]}
807
807
n <- 500
808
808
snr <- 2
809
809
x1 <- rnorm(n)
810
810
x2 <- rnorm(n)
811
811
x3 <- rnorm(n)
812
812
x4 <- as.numeric(rbinom(n,1,0.5))
813
813
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)
815
820
p <- ncol(X)
816
821
mu_x <- mu(X)
817
822
tau_x <- tau(X)
@@ -852,7 +857,7 @@ Here we simulate from the model with the original MCMC sampler, using all of the
852
857
``` {r}
853
858
num_gfr <- 0
854
859
num_burnin <- 1000
855
- num_mcmc <- 1000
860
+ num_mcmc <- 100
856
861
num_samples <- num_gfr + num_burnin + num_mcmc
857
862
bcf_model_mcmc <- bcf(
858
863
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)
871
876
plot(rowMeans(bcf_model_mcmc$tau_hat_test), tau_test,
872
877
xlab = "predicted", ylab = "actual", main = "Treatment effect")
873
878
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)
874
885
sigma_observed <- var(y-E_XZ)
875
886
plot_bounds <- c(min(c(bcf_model_mcmc$sigma2_samples, sigma_observed)),
876
887
max(c(bcf_model_mcmc$sigma2_samples, sigma_observed)))
@@ -894,8 +905,10 @@ mean(cover)
894
905
And test set RMSE
895
906
896
907
``` {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))
899
912
```
900
913
901
914
#### MCMC, covariate subset in $\tau(X)$
@@ -905,7 +918,7 @@ Here we simulate from the model with the original MCMC sampler, using only covar
905
918
``` {r}
906
919
num_gfr <- 0
907
920
num_burnin <- 1000
908
- num_mcmc <- 1000
921
+ num_mcmc <- 100
909
922
num_samples <- num_gfr + num_burnin + num_mcmc
910
923
bcf_model_mcmc <- bcf(
911
924
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)
925
938
plot(rowMeans(bcf_model_mcmc$tau_hat_test), tau_test,
926
939
xlab = "predicted", ylab = "actual", main = "Treatment effect")
927
940
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)
928
947
sigma_observed <- var(y-E_XZ)
929
948
plot_bounds <- c(min(c(bcf_model_mcmc$sigma2_samples, sigma_observed)),
930
949
max(c(bcf_model_mcmc$sigma2_samples, sigma_observed)))
@@ -950,6 +969,8 @@ And test set RMSE
950
969
``` {r}
951
970
test_mean <- rowMeans(bcf_model_mcmc$tau_hat_test)
952
971
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))
953
974
```
954
975
955
976
#### 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
959
980
``` {r}
960
981
num_gfr <- 10
961
982
num_burnin <- 0
962
- num_mcmc <- 1000
983
+ num_mcmc <- 100
963
984
num_samples <- num_gfr + num_burnin + num_mcmc
964
985
bcf_model_warmstart <- bcf(
965
986
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)
978
999
plot(rowMeans(bcf_model_warmstart$tau_hat_test), tau_test,
979
1000
xlab = "predicted", ylab = "actual", main = "Treatment effect")
980
1001
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)
981
1008
sigma_observed <- var(y-E_XZ)
982
1009
plot_bounds <- c(min(c(bcf_model_warmstart$sigma2_samples, sigma_observed)),
983
1010
max(c(bcf_model_warmstart$sigma2_samples, sigma_observed)))
@@ -1001,8 +1028,10 @@ mean(cover)
1001
1028
And test set RMSE
1002
1029
1003
1030
``` {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))
1006
1035
```
1007
1036
1008
1037
#### Warmstart, covariate subset in $\tau(X)$
@@ -1012,14 +1041,14 @@ Here we simulate from the model with the warm-start sampler, using only covariat
1012
1041
``` {r}
1013
1042
num_gfr <- 10
1014
1043
num_burnin <- 0
1015
- num_mcmc <- 1000
1044
+ num_mcmc <- 100
1016
1045
num_samples <- num_gfr + num_burnin + num_mcmc
1017
1046
bcf_model_warmstart <- bcf(
1018
1047
X_train = X_train, Z_train = Z_train, y_train = y_train, pi_train = pi_train,
1019
1048
X_test = X_test, Z_test = Z_test, pi_test = pi_test,
1020
1049
num_gfr = num_gfr, num_burnin = num_burnin, num_mcmc = num_mcmc,
1021
1050
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
1023
1052
)
1024
1053
```
1025
1054
@@ -1032,6 +1061,12 @@ abline(0,1,col="red",lty=3,lwd=3)
1032
1061
plot(rowMeans(bcf_model_warmstart$tau_hat_test), tau_test,
1033
1062
xlab = "predicted", ylab = "actual", main = "Treatment effect")
1034
1063
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)
1035
1070
sigma_observed <- var(y-E_XZ)
1036
1071
plot_bounds <- c(min(c(bcf_model_warmstart$sigma2_samples, sigma_observed)),
1037
1072
max(c(bcf_model_warmstart$sigma2_samples, sigma_observed)))
@@ -1055,8 +1090,10 @@ mean(cover)
1055
1090
And test set RMSE
1056
1091
1057
1092
``` {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))
1060
1097
```
1061
1098
1062
1099
# Continuous Treatment
0 commit comments