Created
August 19, 2024 04:26
-
-
Save wleoncio/bb06f1cb937338ba2ff7fc7365769191 to your computer and use it in GitHub Desktop.
BayesSurvive 2 sub-groups
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| s | |
| ) | |
| ) | |
| # Run a Bayesian Cox model | |
| ## Initial value: null model without covariates | |
| initial <- list("gamma.ini" = rep(0, ncol(dataset$X))) | |
| initial_2S <- list( | |
| initial, | |
| list("gamma.ini" = rep(0, ncol(dataset_2S[[2]]$X))) | |
| ) | |
| # Prior parameters | |
| hyperparPooled = list( | |
| "c0" = 2, # prior of baseline hazard | |
| "tau" = 0.0375, # sd (spike) for coefficient prior | |
| "cb" = 20, # sd (slab) for coefficient prior | |
| "pi.ga" = 0.02, # prior variable selection probability for standard Cox models | |
| "a" = -4, # hyperparameter in MRF prior | |
| "b" = 0.1, # hyperparameter in MRF prior | |
| "G" = simData$G # hyperparameter in MRF prior | |
| ) | |
| hyperparPooled_2S = list(hyperparPooled, hyperparPooled) | |
| # Run a 'Pooled' Bayesian Cox model with graphical learning | |
| set.seed(715074) | |
| BayesSurvive_wrap <- function(data, initial, hyper, model = "Pooled", use_cpp = FALSE) { | |
| suppressWarnings( | |
| BayesSurvive( | |
| survObj = data, model.type = model, MRF.G = TRUE, verbose = FALSE, | |
| hyperpar = hyper, initial = initial, nIter = 10, burnin = 100, | |
| cpp = use_cpp | |
| ) | |
| ) | |
| } | |
| fit_R <- BayesSurvive_wrap(dataset, initial, hyperparPooled) | |
| fit_C <- BayesSurvive_wrap(dataset, initial, hyperparPooled, use_cpp = TRUE) | |
| fit_R2S <- BayesSurvive_wrap(dataset_2S, initial_2S, hyperparPooled, "CoxBVSSL") | |
| fit_C2S <- BayesSurvive_wrap(dataset_2S, initial_2S, hyperparPooled, "CoxBVSSL", use_cpp = TRUE) | |
| test_that("R and C++ objects are similar", { | |
| expect_equal(fit_R$call, fit_C$call) | |
| expect_equal(fit_R$input, fit_C$input) | |
| for (obj in names(fit_R$output)[2]) { | |
| expect_equal(fit_R$output[[obj]], fit_C$output[[obj]], tolerance = 1) | |
| } | |
| }) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment