#################################################
## Example 1: y ~ Binomial (L = 2 centers) ##
#################################################
# Setting a seed for reproducibility
set.seed(112358)
#------------------------------------#
# Data Simulation for Local Center 1 #
#------------------------------------#
n1 <- 30 # sample size of center 1
X1 <- data.frame(x1=rnorm(n1), # continuous variable
x2=sample(0:2, n1, replace=TRUE)) # categorical variable
# make dummy variables
X1x2_1 <- ifelse(X1$x2 == '1', 1, 0)
X1x2_2 <- ifelse(X1$x2 == '2', 1, 0)
X1$x2 <- as.factor(X1$x2)
# regression coefficients
beta <- 1:4 # beta[1] is the intercept
# linear predictor:
eta1 <- beta[1] + X1$x1 * beta[2] + X1x2_1 * beta[3] + X1x2_2 * beta[4]
# inverse of the link function ( g^{-1}(\eta) = \mu ):
mu1 <- binomial()$linkinv(eta1)
y1 <- rbinom(n1, 1, mu1)
#------------------------------------#
# Data Simulation for Local Center 2 #
#------------------------------------#
n2 <- 50 # sample size of center 2
X2 <- data.frame(x1=rnorm(n2), # continuous variable
x2=sample(0:2, n2, replace=TRUE)) # categorical variable
# make dummy variables:
X2x2_1 <- ifelse(X2$x2 == '1', 1, 0)
X2x2_2 <- ifelse(X2$x2 == '2', 1, 0)
X2$x2 <- as.factor(X2$x2)
# linear predictor:
eta2 <- beta[1] + X2$x1 * beta[2] + X2x2_1 * beta[3] + X2x2_2 * beta[4]
# inverse of the link function:
mu2 <- binomial()$linkinv(eta2)
y2 <- rbinom(n2, 1, mu2)
#---------------------------#
# MAP Estimates at Center 1 #
#---------------------------#
# Assume the same inverse covariance matrix (Lambda) for both centers:
Lambda <- inv.prior.cov(X1, lambda = 0.01, family = 'binomial')
fit1 <- MAP.estimation(y1, X1, family = 'binomial', Lambda)
theta_hat1 <- fit1$theta_hat # intercept and coefficient estimates
A_hat1 <- fit1$A_hat # minus the curvature matrix
#---------------------------#
# MAP Estimates at Center 2 #
#---------------------------#
fit2 <- MAP.estimation(y2, X2, family='binomial', Lambda)
theta_hat2 <- fit2$theta_hat
A_hat2 <- fit2$A_hat
#-----------------------#
# BFI at Central Center #
#-----------------------#
theta_hats <- list(theta_hat1, theta_hat2)
A_hats <- list(A_hat1, A_hat2)
bfi <- bfi(theta_hats, A_hats, Lambda, family='binomial')
class(bfi)
summary(bfi, cur_mat=TRUE)
###---------------------###
### Stratified Analysis ###
###---------------------###
# By running the following line an error appears because
# when stratified = TRUE, both 'strat_par' and 'center_spec' can not be NULL:
Just4check1 <- try(bfi(theta_hats, A_hats, Lambda, family = 'binomial',
stratified = TRUE), TRUE)
class(Just4check1) # By default, both 'strat_par' and 'center_spec' are NULL!
# By running the following line an error appears because when stratified = TRUE,
# last matrix in 'Lambda' should not have the same dim. as the other local matrices:
Just4check2 <- try(bfi(theta_hats, A_hats, Lambda, stratified = TRUE,
strat_par = 1), TRUE)
class(Just4check2) # All matices in Lambda have the same dimension!
# Stratified analysis when 'intercept' varies across two centers:
newLam <- inv.prior.cov(X1, lambda=c(0.1, 0.3), family = 'binomial',
stratified = TRUE, strat_par = 1)
bfi <- bfi(theta_hats, A_hats, list(Lambda, newLam), family = 'binomial',
stratified=TRUE, strat_par=1)
summary(bfi, cur_mat=TRUE)
#################################################
## Example 2: y ~ Gaussian (L = 3 centers) ##
#################################################
# Setting a seed for reproducibility
set.seed(112358)
p <- 3 # number of coefficients without 'intercept'
theta <- c(1, rep(2, p), 1.5) # reg. coef.s (theta[1] is 'intercept') & 'sigma2' = 1.5
#------------------------------------#
# Data Simulation for Local Center 1 #
#------------------------------------#
n1 <- 30 # sample size of center 1
X1 <- data.frame(matrix(rnorm(n1 * p), n1, p)) # continuous variables
# linear predictor:
eta1 <- theta[1] + as.matrix(X1)
# inverse of the link function ( g^{-1}(\eta) = \mu ):
mu1 <- gaussian()$linkinv(eta1)
y1 <- rnorm(n1, mu1, sd = sqrt(theta[5]))
#------------------------------------#
# Data Simulation for Local Center 2 #
#------------------------------------#
n2 <- 40 # sample size of center 2
X2 <- data.frame(matrix(rnorm(n2 * p), n2, p)) # continuous variables
# linear predictor:
eta2 <- theta[1] + as.matrix(X2)
# inverse of the link function:
mu2 <- gaussian()$linkinv(eta2)
y2 <- rnorm(n2, mu2, sd = sqrt(theta[5]))
#------------------------------------#
# Data Simulation for Local Center 3 #
#------------------------------------#
n3 <- 50 # sample size of center 3
X3 <- data.frame(matrix(rnorm(n3 * p), n3, p)) # continuous variables
# linear predictor:
eta3 <- theta[1] + as.matrix(X3)
# inverse of the link function:
mu3 <- gaussian()$linkinv(eta3)
y3 <- rnorm(n3, mu3, sd = sqrt(theta[5]))
#---------------------------#
# Inverse Covariance Matrix #
#---------------------------#
# Creating the inverse covariance matrix for the Gaussian prior distribution:
Lambda <- inv.prior.cov(X1, lambda = 0.05, family='gaussian') # the same for both centers
#---------------------------#
# MAP Estimates at Center 1 #
#---------------------------#
fit1 <- MAP.estimation(y1, X1, family = 'gaussian', Lambda)
theta_hat1 <- fit1$theta_hat # intercept and coefficient estimates
A_hat1 <- fit1$A_hat # minus the curvature matrix
#---------------------------#
# MAP Estimates at Center 2 #
#---------------------------#
fit2 <- MAP.estimation(y2, X2, family = 'gaussian', Lambda)
theta_hat2 <- fit2$theta_hat
A_hat2 <- fit2$A_hat
#---------------------------#
# MAP Estimates at Center 3 #
#---------------------------#
fit3 <- MAP.estimation(y3, X3, family = 'gaussian', Lambda)
theta_hat3 <- fit3$theta_hat
A_hat3 <- fit3$A_hat
#-----------------------#
# BFI at Central Center #
#-----------------------#
A_hats <- list(A_hat1, A_hat2, A_hat3)
theta_hats <- list(theta_hat1, theta_hat2, theta_hat3)
bfi <- bfi(theta_hats, A_hats, Lambda, family = 'gaussian')
summary(bfi, cur_mat=TRUE)
###---------------------###
### Stratified Analysis ###
###---------------------###
# Stratified analysis when 'intercept' varies across two centers:
newLam1 <- inv.prior.cov(X1, lambda = c(0.1,0.3), family = 'gaussian',
stratified = TRUE, strat_par = 1, L=3)
# 'newLam1' is used the prior for combined data and
# 'Lambda' is used the prior for locals
list_newLam1 <- list(Lambda, newLam1)
bfi1 <- bfi(theta_hats, A_hats, list_newLam1, family = 'gaussian',
stratified = TRUE, strat_par = 1)
summary(bfi1, cur_mat = TRUE)
# Stratified analysis when 'sigma2' varies across two centers:
newLam2 <- inv.prior.cov(X1, lambda = c(0.1,0.3), family = 'gaussian',
stratified = TRUE, strat_par = 2, L = 3)
# 'newLam2' is used the prior for combined data and 'Lambda' is used the prior for locals
list_newLam2 <- list(Lambda, newLam2)
bfi2 <- bfi(theta_hats, A_hats, list_newLam2, family = 'gaussian',
stratified = TRUE, strat_par=2)
summary(bfi2, cur_mat = TRUE)
# Stratified analysis when 'intercept' and 'sigma2' vary across 2 centers:
newLam3 <- inv.prior.cov(X1, lambda = c(0.1,0.2,0.3), family = 'gaussian',
stratified = TRUE, strat_par = c(1, 2), L = 3)
# 'newLam3' is used the prior for combined data and 'Lambda' is used the prior for locals
list_newLam3 <- list(Lambda, newLam3)
bfi3 <- bfi(theta_hats, A_hats, list_newLam3, family = 'gaussian',
stratified = TRUE, strat_par = 1:2)
summary(bfi3, cur_mat = TRUE)
###----------------------------###
### Center Specific Covariates ###
###----------------------------###
# Assume the first and third centers have the same center-specific covariate value
# of '3', while this value for the second center is '1', i.e., center_spec = c(3,1,3)
newLam4 <- inv.prior.cov(X1, lambda=c(0.1, 0.2, 0.3), family='gaussian',
stratified=TRUE, center_spec = c(3,1,3), L=3)
# 'newLam4' is used the prior for combined data and 'Lambda' is used the prior for locals
l_newLam4 <- list(Lambda, newLam4)
bfi4 <- bfi(theta_hats, A_hats, l_newLam4, family = 'gaussian',
stratified = TRUE, center_spec = c(3,1,3))
summary(bfi4, cur_mat = TRUE)
####################################################
## Example 3: Survival family (L = 2 centers) ##
####################################################
# Setting a seed for reproducibility
set.seed(112358)
p <- 3
theta <- c(1:4, 5, 6) # regression coefficients (1:4) & omega's (5:6)
#---------------------------------------------#
# Simulating Survival data for Local Center 1 #
#---------------------------------------------#
n1 <- 30
X1 <- data.frame(matrix(rnorm(n1 * p), n1, p)) # continuous (normal) variables
# Simulating survival data ('time' and 'status') from 'Weibull' with
# a predefined censoring rate of 0.3:
y1 <- surv.simulate(Z = list(X1), beta = theta[1:p], a = theta[5], b = theta[6],
u1 = 0.1, cen_rate = 0.3, gen_data_from = "weibul")$D[[1]][, 1:2]
Lambda <- inv.prior.cov(X1, lambda = c(0.1, 1), family = "survival", basehaz ="poly")
fit1 <- MAP.estimation(y1, X1, family = 'survival', Lambda = Lambda, basehaz = "poly")
theta_hat1 <- fit1$theta_hat # coefficient estimates
A_hat1 <- fit1$A_hat # minus the curvature matrix
summary(fit1, cur_mat=TRUE)
#---------------------------------------------#
# Simulating Survival data for Local Center 2 #
#---------------------------------------------#
n2 <- 30
X2 <- data.frame(matrix(rnorm(n2 * p), n2, p)) # continuous (normal) variables
# Survival simulated data from 'Weibull' with a predefined censoring rate of 0.3:
y2 <- surv.simulate(Z = list(X2), beta = theta[1:p], a = theta[5], b = theta[6], u1 = 0.1,
cen_rate = 0.3, gen_data_from = "weibul")$D[[1]][, 1:2]
fit2 <- MAP.estimation(y2, X2, family = 'survival', Lambda = Lambda, basehaz = "poly")
theta_hat2 <- fit2$theta_hat
A_hat2 <- fit2$A_hat
summary(fit2, cur_mat=TRUE)
#-----------------------#
# BFI at Central Center #
#-----------------------#
# When family = 'survival' and basehaz = "poly", only 'theta_A_polys'
# should be defined instead of 'theta_hats' and 'A_hats':
theta_A_hats <- list(fit1$theta_A_poly, fit2$theta_A_poly)
qls <- c(fit1$q_l, fit2$q_l)
bfi <- bfi(Lambda = Lambda, family = 'survival', theta_A_polys = theta_A_hats,
basehaz = "poly", q_ls = qls)
summary(bfi, cur_mat=TRUE)
Run the code above in your browser using DataLab