library(GPCERF)
library(ggplot2)
In this vignette, we present an example of using nearest-neighbor Gaussian processes approach in GPCERF to estimate the exposure response function (ERF) of a continuous exposure based on simulated data. We use a synthetic data generation function from the R package CausalGPS.
We first generate a synthetic dataset with six covariates, one
continuous exposure and one outcome. We consider two types of
conditional distributions (normal and student’s t) of the exposure given
covariates. For more details of the synthetic data generation, see this
document.
We then use a function tru_R
to derive the actual ERF of
this population at w=seq(0,20,0.1)
.
set.seed(1)
# Generate dataset with a normally distributed exposure given covariates
<- generate_synthetic_data(sample_size = 500,
data_sim_normal outcome_sd = 10,
gps_spec = 1)
# Generate dataset with a t-distributed with 2df exposure given covariates
<- generate_synthetic_data(sample_size = 500,
data_sim_t outcome_sd = 10,
gps_spec = 2)
<- function(w, sim.data){
tru_R = model.matrix(~cf1+cf2+cf3+cf4+cf5+cf6-1, data = sim.data)
design.mt mean(apply(design.mt, 1, function(x){
-10 - sum(c(2, 2, 3, -1,2,2)*x) -
*(0.1 - 0.1*x[1] + 0.1*x[4] + 0.1*x[5] + 0.1*x[3]^2) + 0.13^2*w^3
w
}))
}
= sapply(seq(0,20,0.1), function(w) tru_R(w, data_sim_normal))
erf_tru_normal = sapply(seq(0,20,0.1), function(w) tru_R(w, data_sim_t)) erf_tru_t
GPCERF will first convert the covariate values into a single composite score (GPS) and then use it to fit the Gaussian processes. We use the GPS estimation function in CausalGPS (see here) to get the GPS model that maps covariates into GPS.
<- train_GPS(cov_mt = as.matrix(data_sim_normal[,-(1:2)]),
GPS_m_normal w_all = as.matrix(data_sim_normal$treat))
<- train_GPS(cov_mt = as.matrix(data_sim_t[,-(1:2)]),
GPS_m_t w_all = as.matrix(data_sim_t$treat))
We then use estimate_cerf_nngp
to estimate the ERF of
the exposure w
. We estimate the ERF at
w = seq(0,20,0.1)
. The estimated ERF as well as its
pointwise 95% credible band is visualized with a call to
plot
. We also plot the actual ERF on top of the estimated
ERF.
= seq(0,20,0.1)
w_all ::setDT(data_sim_normal)
data.table
<- estimate_cerf_nngp(data_sim_normal,
nngp_res_normal
w_all,
GPS_m_normal,params = list(alpha = c(0.1),
beta=0.2,
g_sigma = 1,
n_neighbor = 20,
expand = 1,
block_size = 50,
tune_app = "all"),
nthread = 1)
plot(nngp_res_normal) +
geom_line(data = data.frame(w = w_all, y = erf_tru_normal),
aes(x = w, y = y, color = "True"), size = 1.5)
We can see that the estimated curve follows the true ERF closely and the 95% credible band completely covers the true ERF. But the running time is much smaller than the full GP approach.
::setDT(data_sim_t)
data.table
<- estimate_cerf_nngp(data_sim_t,
nngp_res_t
w_all,
GPS_m_t,params = list(alpha = c(0.1),
beta=0.2,
g_sigma = 1,
n_neighbor = 20,
expand = 1,
block_size = 50,
tune_app = "all"),
nthread = 1)
plot(nngp_res_t) +
geom_line(data = data.frame(w = w_all, y = erf_tru_t),
aes(x = w, y = y, color = "True"), size = 1.5)
The results look very similar to the case where the exposure is normally distributed. The only difference might be that when the exposure is t-distributed, the estimated curve tends to be less smooth.