3 Continuous exposure example
##
## ── R CMD build ─────────────────────────────────────────────────────────────────
## checking for file ‘/home/rstudio/DESCRIPTION’ ... ✔ checking for file ‘/home/rstudio/DESCRIPTION’
## ─ preparing ‘bartcs’: (41.5s)
## checking DESCRIPTION meta-information ... ✔ checking DESCRIPTION meta-information
## ─ cleaning src
## ─ checking for LF line-endings in source and make files and shell scripts (402ms)
## ─ checking for empty or unneeded directories
## ─ building ‘bartcs_1.3.0.tar.gz’
##
## Running /usr/local/lib/R/bin/R CMD INSTALL \
## /tmp/Rtmp57Bhlc/bartcs_1.3.0.tar.gz --install-tests
## * installing to library ‘/usr/local/lib/R/site-library’
## * installing *source* package ‘bartcs’ ...
## ** using staged installation
## ** libs
## using C++ compiler: ‘g++ (Ubuntu 13.3.0-6ubuntu2~24.04) 13.3.0’
## g++ -std=gnu++17 -I"/usr/local/lib/R/include" -DNDEBUG -I'/usr/local/lib/R/site-library/Rcpp/include' -I/usr/local/include -fopenmp -fpic -g -O2 -fstack-protector-strong -Wformat -Werror=format-security -Wdate-time -D_FORTIFY_SOURCE=2 -g -c BART.cpp -o BART.o
## g++ -std=gnu++17 -I"/usr/local/lib/R/include" -DNDEBUG -I'/usr/local/lib/R/site-library/Rcpp/include' -I/usr/local/include -fopenmp -fpic -g -O2 -fstack-protector-strong -Wformat -Werror=format-security -Wdate-time -D_FORTIFY_SOURCE=2 -g -c Models.cpp -o Models.o
## g++ -std=gnu++17 -I"/usr/local/lib/R/include" -DNDEBUG -I'/usr/local/lib/R/site-library/Rcpp/include' -I/usr/local/include -fopenmp -fpic -g -O2 -fstack-protector-strong -Wformat -Werror=format-security -Wdate-time -D_FORTIFY_SOURCE=2 -g -c Node.cpp -o Node.o
## g++ -std=gnu++17 -I"/usr/local/lib/R/include" -DNDEBUG -I'/usr/local/lib/R/site-library/Rcpp/include' -I/usr/local/include -fopenmp -fpic -g -O2 -fstack-protector-strong -Wformat -Werror=format-security -Wdate-time -D_FORTIFY_SOURCE=2 -g -c RcppExports.cpp -o RcppExports.o
## g++ -std=gnu++17 -I"/usr/local/lib/R/include" -DNDEBUG -I'/usr/local/lib/R/site-library/Rcpp/include' -I/usr/local/include -fopenmp -fpic -g -O2 -fstack-protector-strong -Wformat -Werror=format-security -Wdate-time -D_FORTIFY_SOURCE=2 -g -c change.cpp -o change.o
## g++ -std=gnu++17 -I"/usr/local/lib/R/include" -DNDEBUG -I'/usr/local/lib/R/site-library/Rcpp/include' -I/usr/local/include -fopenmp -fpic -g -O2 -fstack-protector-strong -Wformat -Werror=format-security -Wdate-time -D_FORTIFY_SOURCE=2 -g -c count_omp_thread.cpp -o count_omp_thread.o
## g++ -std=gnu++17 -I"/usr/local/lib/R/include" -DNDEBUG -I'/usr/local/lib/R/site-library/Rcpp/include' -I/usr/local/include -fopenmp -fpic -g -O2 -fstack-protector-strong -Wformat -Werror=format-security -Wdate-time -D_FORTIFY_SOURCE=2 -g -c grow.cpp -o grow.o
## g++ -std=gnu++17 -I"/usr/local/lib/R/include" -DNDEBUG -I'/usr/local/lib/R/site-library/Rcpp/include' -I/usr/local/include -fopenmp -fpic -g -O2 -fstack-protector-strong -Wformat -Werror=format-security -Wdate-time -D_FORTIFY_SOURCE=2 -g -c prune.cpp -o prune.o
## g++ -std=gnu++17 -I"/usr/local/lib/R/include" -DNDEBUG -I'/usr/local/lib/R/site-library/Rcpp/include' -I/usr/local/include -fopenmp -fpic -g -O2 -fstack-protector-strong -Wformat -Werror=format-security -Wdate-time -D_FORTIFY_SOURCE=2 -g -c separate_bart.cpp -o separate_bart.o
## g++ -std=gnu++17 -I"/usr/local/lib/R/include" -DNDEBUG -I'/usr/local/lib/R/site-library/Rcpp/include' -I/usr/local/include -fopenmp -fpic -g -O2 -fstack-protector-strong -Wformat -Werror=format-security -Wdate-time -D_FORTIFY_SOURCE=2 -g -c single_bart.cpp -o single_bart.o
## g++ -std=gnu++17 -I"/usr/local/lib/R/include" -DNDEBUG -I'/usr/local/lib/R/site-library/Rcpp/include' -I/usr/local/include -fopenmp -fpic -g -O2 -fstack-protector-strong -Wformat -Werror=format-security -Wdate-time -D_FORTIFY_SOURCE=2 -g -c util.cpp -o util.o
## g++ -std=gnu++17 -shared -L/usr/local/lib/R/lib -L/usr/local/lib -o bartcs.so BART.o Models.o Node.o RcppExports.o change.o count_omp_thread.o grow.o prune.o separate_bart.o single_bart.o util.o -fopenmp -L/usr/local/lib/R/lib -lR
## installing to /usr/local/lib/R/site-library/00LOCK-bartcs/00new/bartcs/libs
## ** R
## ** data
## *** moving datasets to lazyload DB
## ** inst
## ** byte-compile and prepare package for lazy loading
## ** help
## *** installing help indices
## ** building package indices
## ** installing vignettes
## ** testing if installed package can be loaded from temporary location
## ** checking absolute paths in shared objects and dynamic libraries
## ** testing if installed package can be loaded from final location
## ** testing if installed package keeps a record of temporary installation path
## * DONE (bartcs)
set.seed(42)
N <- 300
P <- 100
cov <- list()
for (i in 1:P) {
cov[[i]] <- rnorm(N, 0, 1)
}
X <- do.call(cbind, cov)
h1 <- ifelse(X[, 1] < 0, 1, -1)
h2 <- ifelse(X[, 2] < 0, -1, 1)
prob <- pnorm(0.5 + h1 + h2 - 0.5 * abs(X[, 3] - 1) + 1.5 * X[, 4] * X[, 5])
Trt <- rbinom(N, 1, prob)
mu1 <- 1 * h1 + 1.5 * h2 - 1 + 2 * abs(X[, 3] + 1) + 2 * X[, 4] + exp(0.5 * X[, 5]) -
0.5 * 1 * abs(X[, 6]) - 1 * 1 * abs(X[, 7] + 1)
mu0 <- 1 * h1 + 1.5 * h2 - 0 + 2 * abs(X[, 3] + 1) + 2 * X[, 4] + exp(0.5 * X[, 5]) -
0.5 * 0 * abs(X[, 6]) - 1 * 0 * abs(X[, 7] + 1)
Y1 <- rnorm(N, mu1, 0.3)
Y0 <- rnorm(N, mu0, 0.3)
Y <- Trt * Y1 + (1 - Trt) * Y0
library("tableone")
Xdata <- as.data.frame(cbind(Trt,X))
names(Xdata) <- c("Trt", paste0(rep("X", 100),1:100))
Table <- CreateTableOne(vars = paste0(rep("X", 12),1:12), strata = "Trt",
data = Xdata, test = FALSE)
print(Table, smd = TRUE)
## Stratified by Trt
## 0 1 SMD
## n 164 136
## X1 (mean (SD)) 0.28 (0.96) -0.39 (0.90) 0.718
## X2 (mean (SD)) -0.25 (0.99) 0.24 (0.92) 0.517
## X3 (mean (SD)) -0.14 (1.02) 0.03 (0.90) 0.178
## X4 (mean (SD)) 0.06 (1.08) -0.07 (1.04) 0.118
## X5 (mean (SD)) -0.08 (0.86) 0.01 (1.05) 0.091
## X6 (mean (SD)) -0.03 (1.06) 0.15 (0.98) 0.177
## X7 (mean (SD)) -0.04 (1.03) 0.01 (0.94) 0.050
## X8 (mean (SD)) -0.11 (0.99) 0.20 (1.00) 0.312
## X9 (mean (SD)) 0.07 (1.04) 0.05 (1.02) 0.017
## X10 (mean (SD)) -0.04 (1.13) -0.13 (0.96) 0.087
## X11 (mean (SD)) 0.05 (1.02) -0.12 (0.98) 0.169
## X12 (mean (SD)) 0.13 (1.01) -0.23 (0.99) 0.363
library("bartcs")
separate_fit <- separate_bart(
Y = Y, trt = Trt, X = X, num_tree = 200, num_chain = 4,
num_burn_in = 10000, num_thin = 5, num_post_sample = 2000,
verbose = FALSE
)
separate_fit
## `bartcs` fit by `separate_bart()`
##
## mean 2.5% 97.5%
## SATE -2.2851546 -2.6022894 -1.9692134
## Y1 0.7195622 0.4663024 0.9833689
## Y0 3.0047169 2.8116436 3.1946016
summary(separate_fit)
## `bartcs` fit by `separate_bart()`
##
## Treatment Value
## Treated group : 1
## Control group : 0
##
## Tree Parameters
## Number of Tree : 200 Value of alpha : 0.95
## Prob. of Grow : 0.28 Value of beta : 2
## Prob. of Prune : 0.28 Value of nu : 3
## Prob. of Change : 0.44 Value of q : 0.95
##
## Chain Parameters
## Number of Chains : 4 Number of burn-in : 10000
## Number of Iter : 20000 Number of thinning : 5
## Number of Sample : 2000
##
## Outcome
## estimand chain 2.5% 1Q mean median 3Q
## SATE 1 -2.6070044 -2.3892357 -2.2830389 -2.2800555 -2.1765359
## SATE 2 -2.6013548 -2.4017854 -2.2877997 -2.2877071 -2.1798863
## SATE 3 -2.5961329 -2.3952700 -2.2794876 -2.2793208 -2.1609143
## SATE 4 -2.6090523 -2.4001084 -2.2902924 -2.2923171 -2.1812900
## SATE agg -2.6022894 -2.3965077 -2.2851546 -2.2842764 -2.1748201
## Y1 1 0.4705203 0.6322748 0.7174467 0.7174147 0.8027479
## Y1 2 0.4707973 0.6305094 0.7223111 0.7213076 0.8153911
## Y1 3 0.4653391 0.6277828 0.7190511 0.7194586 0.8080547
## Y1 4 0.4614500 0.6273396 0.7194400 0.7175295 0.8087480
## Y1 agg 0.4663024 0.6292846 0.7195622 0.7185828 0.8087121
## Y0 1 2.8082437 2.9361088 3.0004857 2.9998629 3.0664869
## Y0 2 2.8189069 2.9442181 3.0101107 3.0107896 3.0778268
## Y0 3 2.8002284 2.9362280 2.9985387 2.9972708 3.0646989
## Y0 4 2.8210957 2.9427012 3.0097324 3.0133450 3.0772579
## Y0 agg 2.8116436 2.9404458 3.0047169 3.0053406 3.0713420
## 97.5%
## -1.9757766
## -1.9611401
## -1.9644475
## -1.9761443
## -1.9692134
## 0.9668359
## 0.9851455
## 0.9804701
## 0.9920899
## 0.9833689
## 3.1897135
## 3.2013420
## 3.1920314
## 3.1960383
## 3.1946016
plot(separate_fit, method = "pip", top_n = 10)
plot(separate_fit, method = "pip", threshold = 0.5)
plot(separate_fit, method = 'trace')
plot(separate_fit, method = 'trace', parameter = 'dir_alpha')
# install.packages("bacr", dependencies=TRUE)
library("bacr")
## Loading required package: MCMCpack
## Loading required package: coda
## Loading required package: MASS
## ##
## ## Markov Chain Monte Carlo Package (MCMCpack)
## ## Copyright (C) 2003-2025 Andrew D. Martin, Kevin M. Quinn, and Jong Hee Park
## ##
## ## Support provided by the U.S. National Science Foundation
## ## (Grants SES-0350646 and SES-0350613)
## ##
Z <- as.data.frame(cbind(Y,Trt,X))
fit.bac <- bac(
data = Z, exposure = "Trt", outcome = "Y",
confounders = paste("V", 3:(P + 2), sep = ""),
interactors = NULL, familyX = "binomial", familyY = "gaussian",
omega = Inf, num_its = 20000, burnM = 10000, burnB = 10000, thin = 5
)
## [1] "It took you 949.4 seconds to run BAC"
summary(separate_fit$mcmc_list)
##
## Iterations = 10005:20000
## Thinning interval = 5
## Number of chains = 4
## Sample size per chain = 2000
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## SATE -2.285155 0.1639173 1.833e-03 2.489e-03
## Y1 0.719562 0.1328857 1.486e-03 2.122e-03
## Y0 3.004717 0.0977850 1.093e-03 1.790e-03
## dir_alpha 1.576421 0.7317213 8.181e-03 6.836e-02
## sigma2_out1 0.001731 0.0003359 3.756e-06 5.533e-06
## sigma2_out0 0.001310 0.0002334 2.609e-06 3.784e-06
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## SATE -2.6022894 -2.396508 -2.284276 -2.174820 -1.969213
## Y1 0.4663024 0.629285 0.718583 0.808712 0.983369
## Y0 2.8116436 2.940446 3.005341 3.071342 3.194602
## dir_alpha 0.5772667 1.024000 1.423480 2.003651 3.390765
## sigma2_out1 0.0011718 0.001490 0.001698 0.001935 0.002483
## sigma2_out0 0.0009263 0.001146 0.001289 0.001446 0.001845
plot(separate_fit$mcmc_list)
Connection to coda package
library("coda")
tryCatch({
gelman.diag(separate_fit$mcmc_list)
}, error = function(e) {
gelman.diag(separate_fit$mcmc_list, multivariate = FALSE)
})
## Potential scale reduction factors:
##
## Point est. Upper C.I.
## SATE 1.00 1.00
## Y1 1.00 1.00
## Y0 1.00 1.01
## dir_alpha 1.02 1.07
## sigma2_out1 1.00 1.00
## sigma2_out0 1.00 1.00
4. Readl data example
data("ihdp", package = "bartcs")
single_fit <- single_bart(
Y = ihdp$y_factual,
trt = ihdp$treatment,
X = ihdp[, 6:30],
num_tree = 50,
num_chain = 4,
num_post_sample = 2000,
num_thin = 5,
num_burn_in = 10000,
verbose = FALSE
)
single_fit
## `bartcs` fit by `single_bart()`
##
## mean 2.5% 97.5%
## SATE 3.957549 3.748636 4.174559
## Y1 6.375399 6.182010 6.573097
## Y0 2.417850 2.335916 2.496761
summary(single_fit)
## `bartcs` fit by `single_bart()`
##
## Treatment Value
## Treated group : 1
## Control group : 0
##
## Tree Parameters
## Number of Tree : 50 Value of alpha : 0.95
## Prob. of Grow : 0.28 Value of beta : 2
## Prob. of Prune : 0.28 Value of nu : 3
## Prob. of Change : 0.44 Value of q : 0.95
##
## Chain Parameters
## Number of Chains : 4 Number of burn-in : 10000
## Number of Iter : 20000 Number of thinning : 5
## Number of Sample : 2000
##
## Outcome
## estimand chain 2.5% 1Q mean median 3Q 97.5%
## SATE 1 3.746043 3.873081 3.948641 3.946881 4.019926 4.160547
## SATE 2 3.751288 3.889213 3.961313 3.958479 4.037102 4.178233
## SATE 3 3.751639 3.886315 3.962115 3.962983 4.037902 4.171984
## SATE 4 3.748706 3.886030 3.958125 3.959373 4.029561 4.186227
## SATE agg 3.748636 3.883616 3.957549 3.957378 4.031393 4.174559
## Y1 1 6.178465 6.297708 6.366183 6.367383 6.431393 6.566431
## Y1 2 6.179921 6.308329 6.378269 6.378778 6.447167 6.576537
## Y1 3 6.188251 6.313731 6.380773 6.379902 6.448027 6.570700
## Y1 4 6.184960 6.307605 6.376369 6.375525 6.444051 6.580341
## Y1 agg 6.182010 6.306705 6.375399 6.375194 6.443208 6.573097
## Y0 1 2.337418 2.390153 2.417541 2.416894 2.446144 2.496748
## Y0 2 2.334446 2.389581 2.416956 2.417375 2.444827 2.495226
## Y0 3 2.337860 2.392030 2.418658 2.418164 2.445333 2.497071
## Y0 4 2.335309 2.391460 2.418245 2.418278 2.445988 2.496955
## Y0 agg 2.335916 2.390744 2.417850 2.417717 2.445566 2.496761
separate_fit <- separate_bart(
Y = ihdp$y_factual,
trt = ihdp$treatment,
X = ihdp[, 6:30],
num_tree = 50,
num_chain = 4,
num_post_sample = 2000,
num_thin = 5,
num_burn_in = 10000,
verbose = FALSE
)
separate_fit
## `bartcs` fit by `separate_bart()`
##
## mean 2.5% 97.5%
## SATE 3.924215 3.702296 4.143236
## Y1 6.342427 6.131224 6.551996
## Y0 2.418213 2.338535 2.496362
plot(single_fit, method = 'trace')
5. Continuous exposure example
set.seed(42)
N <- 300
P <- 100
cov <- list()
for (i in 1:P) {
cov[[i]] <- rnorm(N, 0, 1)
}
X <- do.call(cbind, cov)
h1 <- ifelse(X[, 1] < 0, 1, -1)
h2 <- ifelse(X[, 2] < 0, -1, 1)
mu_trt <- 0.5 + h1 + h2 - 0.5 * abs(X[, 3] - 1) + 0.5 * X[, 4] * X[, 5]
Trt <- rnorm(N, mu_trt, 0.3)
mu_y <- 1 * h1 + 1 * h2 - Trt + 1 * abs(X[, 3] + 1) + 1 * X[, 4] + exp(0.5 * X[, 5]) -
0.5 * Trt * abs(X[, 6]) - 0.5 * Trt * abs(X[, 7] + 1)
Y <- rnorm(N, mu_y, 0.3)
treatment <- quantile(Trt, 0.75)
control <- quantile(Trt, 0.25)
single_fit <- single_bart(
Y = Y, trt = Trt, X = X,
trt_treated = treatment, trt_control = control,
num_tree = 200, num_chain = 4,
num_burn_in = 10000, num_thin = 5, num_post_sample = 2000,
verbose = FALSE
)
single_fit
## `bartcs` fit by `single_bart()`
##
## mean 2.5% 97.5%
## SATE -2.670467 -3.8362353 -1.781589
## Y1 1.058132 0.4296365 1.661963
## Y0 3.728599 3.1192335 4.488202