Bayesian Federated Inference

bfi function can be used (on the central server) to combine inference results from separate datasets (without combining the data) to approximate what would have been inferred had the datasets been merged. This function can handle linear, logistic and survival regression models.

Usage

bfi(theta_hats = NULL,
    A_hats,
    Lambda,
    family = c("gaussian", "binomial", "survival"),
    stratified = FALSE,
    strat_par = NULL,
    center_cluster = NULL,
    basehaz = c("weibul", "exp", "gomp", "poly", "pwexp", "unspecified"),
    theta_A_polys = NULL,
    p,
    q_ls,
    center_zero_sample = FALSE,
    which_cent_zeros,
    zero_sample_covs,
    refer_cats,
    zero_cats,
    lev_no_ref_zeros)

Arguments

theta_hats

a list of \(L\) vectors of the maximum a posteriori (MAP) estimates of the model parameters in the \(L\) centers. These vectors must have equal dimensions. See ‘Details’.

A_hats

a list of \(L\) minus curvature matrices for \(L\) centers. These matrices must have equal dimensions. See ‘Details’.

family

a character string representing the family name used for the local centers. Can be abbreviated.

Lambda

a list of \(L+1\) matrices. The \(k^{\th}\) matrix is the chosen inverse variance-covariance matrix of the Gaussian distribution that is used as prior distribution in center \(k\), where \(k=1,2,\ldots,L\). The last matrix is the chosen variance-covariance matrix for the Gaussian prior of the (fictive) combined data set. If stratified = FALSE, all \(L+1\) matrices must have equal dimensions. While, if stratified = TRUE, the first \(L\) matrices must have equal dimensions and the last matrix should have a different (greater) dimention than the others. See ‘Details’.

stratified

logical flag for performing the stratified analysis. If stratified = TRUE, the parameter(s) selected in the strat_par argument are allowed to be different across centers (to deal with heterogeneity across centers), except when the argument center_cluster is not NULL. Default is stratified = FALSE. See ‘Details’ and ‘Examples’.

strat_par

a integer vector for indicating the stratification parameter(s). It can be used to deal with heterogeneity due to center-specific parameters. For the "binomial" and "gaussian" families it is a one- or two-element integer vector so that the values \(1\) and/or \(2\) are/is used to indicate that the “intercept” and/or “sigma2” are allowed to vary, respectively. For the "binomial" family the length of the vector should be at most one which refers to “intercept”, and the value of this element should be \(1\) (to handel heterogeneity across outcome means). For "gaussian" this vector can be \(1\) for indicating the “intercept” only (handeling heterogeneity across outcome means), \(2\) for indicating the “sigma2” only (handeling heterogeneity due to nuisance parameter), and c(\(1\), \(2\)) for both “intercept” and “sigma2”. When family = "survival", this vector can contain any combination from 1 to the maximum number of parameters of the baseline function, i.e., \(1\) for "exp", \(2\) for "weibul" and "gomp", max_order + 1 for "poly", and n_intervals for "pwexp". This argument is used only when stratified = TRUE and center_cluster = NULL. Default is strat_par = NULL. See ‘Details’ and ‘Examples’.

center_cluster

a vector of \(L\) elements to account for the heterogeneity across centers due to clustering. This argument is used only when stratified = TRUE and strat_par = NULL. Each element represents a specific feature of the corresponding center. There must be only one specific value or attribute for each center. This vector could be a numeric, characteristic or factor vector. Note that, the order of the centers in the vector center_cluster must be the same as in the list of the argument theta_hats. The used data type in the argument center_cluster must be categorical. Default is center_cluster = NULL. See also ‘Details’ and ‘Examples’.

basehaz

a character string representing one of the available baseline hazard functions; exponential ("exp"), Weibull ("weibul", the default), Gompertz ("gomp"), exponentiated polynomial ("poly"), piecewise exponential ("pwexp"), and unspecified baseline hazard ("unspecified"). It is only used when family = "survival". Can be abbreviated.

theta_A_polys

a list with \(L\) elements so that each element is the array theta_A_ploy (the output of the MAP.estimation function, MAP.estimation()$theta_A_ploy) for the corresponding center. This argument, theta_A_polys, is only used if family = "survival" and basehaz = "poly". See ‘Details’.

p

an integer representing the number of covariates/coefficients. It can be found from the output of the MAP.estimation function, MAP.estimation()$np). This argument, p, is only used if stratified = TRUE and family = "survival".

q_ls

a vector with \(L\) elements in which each element is the order (minus 1) of the exponentiated polynomial baseline hazard function for the corresponding center, i.e., each element is the value of q_l (the output of the MAP.estimation function, MAP.estimation()$q_l). This argument, q_ls, is only used if family = "survival", family = "survival" and basehaz = "poly". It can also be a scalar which represents the maximum value of the q_l's across the centers.

center_zero_sample

logical flag indicating whether the center has a categorical covariate with no observations/individuals in one of the categories. It is used to address heterogeneity across centers due to center-specific covariates. Default is center_zero_sample = FALSE. For more detailes see ‘References’.

which_cent_zeros

an integer vector representing the center(s) which has one categorical covariate with no individuals in one of the categories. It is used if center_zero_sample = TRUE.

zero_sample_covs

a vector in which each element is a character string representing the categorical covariate that has no samples/observations in one of its categories for the corresponding center. Each element of the vector can be obtained from the output of the MAP.estimation function for the corresponding center, MAP.estimation()$zero_sample_cov. It is used when center_zero_sample = TRUE.

refer_cats

a vector in which each element is a character string representing the reference category for the corresponding center. Each element of the vector can be obtained from the output of the MAP.estimation function for the corresponding center, MAP.estimation()$refer_cat. This vector is used when center_zero_sample = TRUE.

zero_cats

a vector in which each element is a character string representing the category with no samples/observations for the corresponding center. Each element of the vector can be obtained from the output of the MAP.estimation function for the corresponding center, i.e., MAP.estimation()$zero_cat. It is used when center_zero_sample = TRUE.

lev_no_ref_zeros

a list in which the number of elements equals the length of the which_cent_zeros argument. Each element of the list is a vector containing the names of the levels of the categorical covariate that has no samples/observations in one of its categories for the corresponding center. However, the name of the category with no samples and the name of the reference category are excluded from this vector. Each element of the list can be obtained from the output of the MAP.estimation function, i.e., MAP.estimation()$lev_no_ref_zero. This argument is used if center_zero_sample = TRUE.

Value

bfi returns a list containing the following components:

theta_hat

the vector of estimates obtained by combining the inference results from the \(L\) centers with the 'BFI' methodology. If an intercept was fitted in every center and stratified = FALSE, there is only one general “intercept” in this vector, while if stratified = TRUE and strat_par = 1, there are \(L\) different intercepts in the model, for each center one;

A_hat

minus the curvature (or Hessian) matrix obtained by the 'BFI' method for the combined model. If stratified = TRUE, the dimension of the matrix is always greater than when stratified = FALSE;

sd

the vector of standard deviation of the estimates in theta_hat obtained from the matrix in A_hat, i.e., the vector equals sqrt(diag(solve(A_hat))) which equals the square root of the elements at the diagonal of the inverse of the A_hat matrix.

family

the family object used;

basehaz

the baseline hazard function used;

stratified

whether a stratified analysis was done or not.;

Details

bfi function implements the BFI approach described in the papers Jonker et. al. (2024a), Pazira et. al. (2024) and Jonker et. al. (2024b) given in the references. The inference results gathered from different (\(L\)) centers are combined, and the BFI estimates of the model parameters and curvature matrix evaluated at that point are returned.

The inference result from each center must be obtained using the MAP.estimation function separately, and then all of these results (coming from different centers) should be compiled into a list to be used as an input of bfi(). The models in the different centers should be defined in exactly the same way; among others, exactly the same covariates should be included in the models. The parameter vectors should be defined exactly the same, so that the \(L\) vectors and matrices in the input lists theta_hat's and A_hat's are defined in the same way (e.g., the covariates need to be included in the models in the same order).

Note that the order of the elements in the lists theta_hats, A_hats and Lambda, must be the same with respect to the centers, so that in every list the element at the \(\ell^{\th}\) position is from the center \(\ell\). This should also be the case for the vector center_cluster.

If for the locations intercept = FALSE, the stratified analysis is not possible anymore for the binomial family.

If stratified = FALSE, both strat_par and center_cluster must be NULL (the defaults), while if stratified = TRUE only one of the two must be NULL.

If stratified = FALSE and all the \(L+1\) matrices in Lambda are equal, it is sufficient to give a (list of) one matrix only. In both cases of the stratified argument (TRUE or FALSE), if only the first \(L\) matrices are equal, the argument Lambda can be a list of two matrices, so that the fist matrix represents the chosen variance-covariance matrix for local centers and the second one is the chosen matrix for the combined data set. The last matrix of the list in the argument Lambda can be built by the function inv.prior.cov().

If the data type used in the argument center_cluster is continuous, one can use stratified = TRUE and center_cluster = NULL, and set strat_par not to NULL (i.e., to \(1\), \(2\) or both \((1, 2)\)). Indeed, in this case, the stratification parameter(s) given in the argument strat_par are assumed to be different across the centers.

When family = 'survival' and basehaz = 'poly', the arguments theta_hats and A_hats should not be provided. Instead, the theta_A_polys and q_ls arguments should be defined using the local information, specifically MAP.estimation()$theta_A_poly and MAP.estimation()$q_l, respectively. See the last example in ‘Examples’.

References

Jonker M.A., Pazira H. and Coolen A.C.C. (2024a). Bayesian federated inference for estimating statistical models based on non-shared multicenter data sets, Statistics in Medicine, 43(12): 2421-2438. <https://doi.org/10.1002/sim.10072>

Pazira H., Massa E., Weijers J.A.M., Coolen A.C.C. and Jonker M.A. (2024). Bayesian Federated Inference for Survival Models, arXiv. <https://arxiv.org/abs/2404.17464>

Jonker M.A., Pazira H. and Coolen A.C.C. (2024b). Bayesian Federated Inference for regression models with heterogeneous multi-center populations, arXiv. <https://arxiv.org/abs/2402.02898>

Author

Hassan Pazira and Marianne Jonker
Maintainer: Hassan Pazira hassan.pazira@radboudumc.nl

See also

MAP.estimation and inv.prior.cov

Examples

#################################################
##  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)
#> Error in MAP.estimation(y1, X1, family = "binomial", Lambda): The algorithm did not converge.
theta_hat1 <- fit1$theta_hat # intercept and coefficient estimates
#> Error: object 'fit1' not found
A_hat1     <- fit1$A_hat     # minus the curvature matrix
#> Error: object 'fit1' not found

#---------------------------#
# MAP Estimates at Center 2 #
#---------------------------#
fit2       <- MAP.estimation(y2, X2, family='binomial', Lambda)
#> Error in MAP.estimation(y2, X2, family = "binomial", Lambda): The algorithm did not converge.
theta_hat2 <- fit2$theta_hat
#> Error: object 'fit2' not found
A_hat2     <- fit2$A_hat
#> Error: object 'fit2' not found

#-----------------------#
# BFI at Central Center #
#-----------------------#
theta_hats <- list(theta_hat1, theta_hat2)
#> Error: object 'theta_hat1' not found
A_hats     <- list(A_hat1, A_hat2)
#> Error: object 'A_hat1' not found
bfi        <- bfi(theta_hats, A_hats, Lambda, family='binomial')
#> Error: object 'theta_hats' not found
class(bfi)
#> [1] "function"
summary(bfi, cur_mat=TRUE)
#> Error in object[[i]]: object of type 'closure' is not subsettable

###---------------------###
### Stratified Analysis ###
###---------------------###

# By running the following line an error appears because
# when stratified = TRUE, both 'strat_par' and 'center_cluster' 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_cluster' are NULL!
#> [1] "try-error"

# 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!
#> [1] "try-error"

# 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)
#> Error: object 'theta_hats' not found
summary(bfi, cur_mat=TRUE)
#> Error in object[[i]]: object of type 'closure' is not subsettable


#################################################
##  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)
#> Error in MAP.estimation(y1, X1, family = "gaussian", Lambda): The algorithm did not converge.
theta_hat1 <- fit1$theta_hat # intercept and coefficient estimates
#> Error: object 'fit1' not found
A_hat1     <- fit1$A_hat     # minus the curvature matrix
#> Error: object 'fit1' not found

#---------------------------#
# MAP Estimates at Center 2 #
#---------------------------#
fit2       <- MAP.estimation(y2, X2, family = 'gaussian', Lambda)
#> Error in MAP.estimation(y2, X2, family = "gaussian", Lambda): The algorithm did not converge.
theta_hat2 <- fit2$theta_hat
#> Error: object 'fit2' not found
A_hat2     <- fit2$A_hat
#> Error: object 'fit2' not found

#---------------------------#
# MAP Estimates at Center 3 #
#---------------------------#
fit3       <- MAP.estimation(y3, X3, family = 'gaussian', Lambda)
#> Error in MAP.estimation(y3, X3, family = "gaussian", Lambda): The algorithm did not converge.
theta_hat3 <- fit3$theta_hat
#> Error: object 'fit3' not found
A_hat3     <- fit3$A_hat
#> Error: object 'fit3' not found

#-----------------------#
# BFI at Central Center #
#-----------------------#
A_hats     <- list(A_hat1, A_hat2, A_hat3)
#> Error: object 'A_hat1' not found
theta_hats <- list(theta_hat1, theta_hat2, theta_hat3)
#> Error: object 'theta_hat1' not found
bfi        <- bfi(theta_hats, A_hats, Lambda, family = 'gaussian')
#> Error: object 'theta_hats' not found
summary(bfi, cur_mat=TRUE)
#> Error in object[[i]]: object of type 'closure' is not subsettable

###---------------------###
### 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 as the prior for combined data and
# 'Lambda' is used as the prior for locals
list_newLam1 <- list(Lambda, newLam1)
bfi1 <- bfi(theta_hats, A_hats, list_newLam1, family = 'gaussian',
            stratified = TRUE, strat_par = 1)
#> Error: object 'theta_hats' not found
summary(bfi1, cur_mat = TRUE)
#> Error: object 'bfi1' not found

# 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 as the prior for combined data and 'Lambda' is used as the prior for locals
list_newLam2 <- list(Lambda, newLam2)
bfi2 <- bfi(theta_hats, A_hats, list_newLam2, family = 'gaussian',
            stratified = TRUE, strat_par=2)
#> Error: object 'theta_hats' not found
summary(bfi2, cur_mat = TRUE)
#> Error: object 'bfi2' not found

# 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 as the prior for combined data and 'Lambda' is used as 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)
#> Error: object 'theta_hats' not found
summary(bfi3, cur_mat = TRUE)
#> Error: object 'bfi3' not found

###----------------------------###
### 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_cluster = c(3,1,3)
newLam4 <- inv.prior.cov(X1, lambda=c(0.1, 0.2, 0.3), family='gaussian',
                         stratified=TRUE, center_cluster = c(3,1,3), L=3)
# 'newLam4' is used as the prior for combined data and 'Lambda' is used as the prior for locals
l_newLam4 <- list(Lambda, newLam4)
bfi4 <- bfi(theta_hats, A_hats, l_newLam4, family = 'gaussian',
            stratified = TRUE, center_cluster = c(3,1,3))
#> Error: object 'theta_hats' not found
summary(bfi4, cur_mat = TRUE)
#> Error: object 'bfi4' not found


####################################################
##  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)
#> 
#> Summary of the local model:
#> 
#>    Formula: Survival(time, status) ~ X1 + X2 + X3 
#>     Family: ‘survival’ 
#>   Baseline: ‘poly’
#> 
#> Coefficients:
#> 
#>         Estimate Std.Dev CI 2.5% CI 97.5%
#> X1        0.6589  0.2443  0.1801   1.1378
#> X2        0.8425  0.2128  0.4255   1.2595
#> X3        1.4327  0.2359  0.9704   1.8951
#> omega_0  -1.5158  0.2166 -1.9403  -1.0913
#> omega_1   1.8742  0.3310  1.2255   2.5228
#> omega_2   1.7874  0.5340  0.7408   2.8340
#> 
#> log Lik Posterior:  -1.275 
#>       Convergence:  0 
#> 
#> Minus the Curvature Matrix: 
#> 
#>              X1      X2      X3 omega_0 omega_1 omega_2
#> X1      19.9169 -7.9165 -1.8776  2.0008  0.4276 -0.1580
#> X2      -7.9165 26.1009  1.3864  4.1509  0.4604  0.3718
#> X3      -1.8776  1.3864 23.3546  3.4463 -3.3272 -4.4365
#> omega_0  2.0008  4.1509  3.4463 33.5158  9.5086  7.3123
#> omega_1  0.4276  0.4604 -3.3272  9.5086 15.3123  6.5539
#> omega_2 -0.1580  0.3718 -4.4365  7.3123  6.5539  7.3698

#---------------------------------------------#
# 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)
#> 
#> Summary of the local model:
#> 
#>    Formula: Survival(time, status) ~ X1 + X2 + X3 
#>     Family: ‘survival’ 
#>   Baseline: ‘poly’
#> 
#> Coefficients:
#> 
#>         Estimate Std.Dev CI 2.5% CI 97.5%
#> X1        0.5961  0.2320  0.1414   1.0509
#> X2        0.4218  0.1837  0.0618   0.7817
#> X3        1.2563  0.2362  0.7934   1.7192
#> omega_0  -1.0431  0.2075 -1.4497  -0.6365
#> omega_1   2.0875  0.3292  1.4422   2.7328
#> omega_2  -0.1028  0.2806 -0.6528   0.4473
#> 
#> log Lik Posterior:  -6.197 
#>       Convergence:  0 
#> 
#> Minus the Curvature Matrix: 
#> 
#>              X1      X2      X3 omega_0 omega_1 omega_2
#> X1      20.3039  1.7314  2.0927  0.5517 -3.0791 -6.2397
#> X2       1.7314 31.2288  4.3588  1.2219 -3.6742 -4.7424
#> X3       2.0927  4.3588 24.5192  7.9651 -2.9422 -8.3513
#> omega_0  0.5517  1.2219  7.9651 33.0430  8.5748  8.9323
#> omega_1 -3.0791 -3.6742 -2.9422  8.5748 16.9323 13.7961
#> omega_2 -6.2397 -4.7424 -8.3513  8.9323 13.7961 26.8460

#-----------------------#
# 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)
#> 
#> Summary of the BFI model:
#> 
#>     Family: ‘survival’ 
#>   Baseline: ‘poly’
#> 
#> Coefficients:
#> 
#>         Estimate Std.Dev CI 2.5% CI 97.5%
#> X1        0.6009  0.1647  0.2781   0.9237
#> X2        0.6306  0.1361  0.3638   0.8974
#> X3        1.2684  0.1645  0.9460   1.5908
#> omega_0  -1.2108  0.1483 -1.5015  -0.9201
#> omega_1   2.2308  0.2386  1.7632   2.6985
#> omega_2   0.1755  0.2470 -0.3087   0.6597
#> 
#> Minus the Curvature Matrix: 
#> 
#>              X1      X2       X3 omega_0 omega_1  omega_2
#> X1      40.1208 -6.1851   0.2152  2.5525 -2.6515  -6.3977
#> X2      -6.1851 57.2297   5.7451  5.3728 -3.2138  -4.3706
#> X3       0.2152  5.7451  47.7738 11.4113 -6.2694 -12.7878
#> omega_0  2.5525  5.3728  11.4113 65.5588 18.0834  16.2445
#> omega_1 -2.6515 -3.2138  -6.2694 18.0834 31.2445  20.3501
#> omega_2 -6.3977 -4.3706 -12.7878 16.2445 20.3501  33.2158


###---------------------###
### Stratified Analysis ###
###---------------------###

# Stratified analysis when first parameter ('omega_0') varies across two centers:
(newLam0 <- inv.prior.cov(X1, lambda = c(rep(1, 3), 0.3, 0.7, rep(2,2)),
                          family = 'survival', stratified = TRUE,
                          basehaz = c("poly"), strat_par = 1, L = 2))
#>              X1 X2 X3 omega_0_loc1 omega_0_loc2 omega_1 omega_2
#> X1            1  0  0          0.0          0.0       0       0
#> X2            0  1  0          0.0          0.0       0       0
#> X3            0  0  1          0.0          0.0       0       0
#> omega_0_loc1  0  0  0          0.3          0.0       0       0
#> omega_0_loc2  0  0  0          0.0          0.7       0       0
#> omega_1       0  0  0          0.0          0.0       2       0
#> omega_2       0  0  0          0.0          0.0       0       2
# 'newLam0' is used as the prior for combined data and 'Lambda' is used as for locals:
list_newLam0 <- list(Lambda, newLam0)
bfi0 <- bfi(Lambda = list_newLam0, family = 'survival', theta_A_polys = theta_A_hats,
            stratified = TRUE, basehaz = c("poly"), p = 3, q_ls = qls, strat_par = 1)
summary(bfi0, cur_mat = TRUE)
#> 
#> Summary of the BFI model:
#> 
#>     Family: ‘survival’ 
#>   Baseline: ‘poly’
#> 
#> Coefficients:
#> 
#>              Estimate Std.Dev CI 2.5% CI 97.5%
#> X1             0.5812  0.1625  0.2627   0.8996
#> X2             0.6168  0.1351  0.3520   0.8816
#> X3             1.2269  0.1628  0.9078   1.5460
#> omega_0_loc1  -1.2097  0.1904 -1.5829  -0.8365
#> omega_0_loc2  -1.1427  0.1958 -1.5264  -0.7590
#> omega_1        2.1174  0.2307  1.6652   2.5696
#> omega_2        0.1988  0.2386 -0.2687   0.6664
#> 
#> Minus the Curvature Matrix: 
#> 
#>                   X1      X2       X3 omega_0_loc1 omega_0_loc2 omega_1
#> X1           41.0208 -6.1851   0.2152       2.0008       0.5517 -2.6515
#> X2           -6.1851 58.1297   5.7451       4.1509       1.2219 -3.2138
#> X3            0.2152  5.7451  48.6738       3.4463       7.9651 -6.2694
#> omega_0_loc1  2.0008  4.1509   3.4463      32.8158       0.0000  9.5086
#> omega_0_loc2  0.5517  1.2219   7.9651       0.0000      32.7430  8.5748
#> omega_1      -2.6515 -3.2138  -6.2694       9.5086       8.5748 32.2445
#> omega_2      -6.3977 -4.3706 -12.7878       7.3123       8.9323 20.3501
#>               omega_2
#> X1            -6.3977
#> X2            -4.3706
#> X3           -12.7878
#> omega_0_loc1   7.3123
#> omega_0_loc2   8.9323
#> omega_1       20.3501
#> omega_2       34.2158


# Stratified analysis when the first and second parameters ('omega_0' and 'omega_1')
# vary across two centers:
newLam1 <- inv.prior.cov(X1, lambda = c(rep(1, 3), 0.3, 0.7, 0.5, 0.8, 2),
                         family = 'survival', stratified = TRUE, basehaz = c("poly"),
                         strat_par = c(1, 2), L = 2)
# 'newLam1' is used as the prior for combined data:
list_newLam1 <- list(Lambda, newLam1)
bfi1 <- bfi(Lambda = list_newLam1, family = 'survival', theta_A_polys = theta_A_hats,
            stratified = TRUE, basehaz = c("poly"), p = 3, q_ls = qls, strat_par = c(1, 2))
summary(bfi1, cur_mat = TRUE)
#> 
#> Summary of the BFI model:
#> 
#>     Family: ‘survival’ 
#>   Baseline: ‘poly’
#> 
#> Coefficients:
#> 
#>              Estimate Std.Dev CI 2.5% CI 97.5%
#> X1             0.5704  0.1594  0.2579   0.8829
#> X2             0.6066  0.1307  0.3505   0.8627
#> X3             1.2503  0.1471  0.9620   1.5386
#> omega_0_loc1  -1.3203  0.1855 -1.6839  -0.9567
#> omega_0_loc2  -1.1006  0.1792 -1.4518  -0.7493
#> omega_1_loc1   2.4654  0.3023  1.8729   3.0579
#> omega_1_loc2   1.8937  0.3117  1.2828   2.5045
#> omega_2        0.2404  0.2224 -0.1955   0.6764
#> 
#> Minus the Curvature Matrix: 
#> 
#>                   X1      X2       X3 omega_0_loc1 omega_0_loc2 omega_1_loc1
#> X1           41.0208 -6.1851   0.2152       2.0008       0.5517       0.4276
#> X2           -6.1851 58.1297   5.7451       4.1509       1.2219       0.4604
#> X3            0.2152  5.7451  48.6738       3.4463       7.9651      -3.3272
#> omega_0_loc1  2.0008  3.4463   0.4276      32.8158       0.0000       9.5086
#> omega_0_loc2  0.5517  7.9651  -3.0791       0.0000      32.7430       0.0000
#> omega_1_loc1  4.1509  7.3123   0.4604       9.5086       0.0000      14.8123
#> omega_1_loc2  1.2219  8.9323  -3.6742       0.0000       8.5748       0.0000
#> omega_2      -6.3977 -4.3706 -12.7878       7.3123       8.9323       6.5539
#>              omega_1_loc2  omega_2
#> X1                -3.0791  -6.3977
#> X2                -3.6742  -4.3706
#> X3                -2.9422 -12.7878
#> omega_0_loc1       0.0000  -3.3272
#> omega_0_loc2       8.5748  -2.9422
#> omega_1_loc1       0.0000   6.5539
#> omega_1_loc2      16.7323  13.7961
#> omega_2           13.7961  34.2158