From 210fad773ab340e3a7677d2846abafc0e8ced4ee Mon Sep 17 00:00:00 2001 From: Nicole Erler Date: Tue, 16 Jan 2024 16:28:44 +0100 Subject: [PATCH] changes to allow for non-linear functions of time-dependent covariates in the survival sub-model of a joint model --- R/JAGSmodel_glmm.R | 3 +-- R/JAGSmodel_surv.R | 12 ++++++++++-- R/get_model_info.R | 12 ++++++++---- R/helpfunctions_JAGSmodel.R | 21 +++++++++++++++++++-- 4 files changed, 38 insertions(+), 10 deletions(-) diff --git a/R/JAGSmodel_glmm.R b/R/JAGSmodel_glmm.R index 1553e26b..5bd0fbea 100644 --- a/R/JAGSmodel_glmm.R +++ b/R/JAGSmodel_glmm.R @@ -164,10 +164,9 @@ glmm_in_jm <- function(info) { " <- ", add_linebreaks(Z_predictor, indent = linkindent + 12 + nchar(info$varname) + 9 + nchar(index)), - "\n", + tab(6), info$trafos, tab(4), "}\n", dummies, - info$trafos, "\n" ) } diff --git a/R/JAGSmodel_surv.R b/R/JAGSmodel_surv.R index a893699f..fd0091ff 100644 --- a/R/JAGSmodel_surv.R +++ b/R/JAGSmodel_surv.R @@ -178,6 +178,7 @@ jagsmodel_coxph <- function(info) { covnames = vector(mode = "list", length = length(info$lp[["M_lvlone"]] )), + trafo = info$fcts_all, isgk = FALSE) }), collapse = " + ") @@ -198,6 +199,7 @@ jagsmodel_coxph <- function(info) { covnames = vector(mode = "list", length = length( info$lp[["M_lvlone"]])), + trafo = info$fcts_all, isgk = TRUE) } ), collapse = " + "), @@ -333,7 +335,10 @@ jagsmodel_jm <- function(info) { cols = info$lp[["M_lvlone"]], scale_pars = info$scale_pars[["M_lvlone"]], assoc_type = info$assoc_type, - covnames = names(info$lp[["M_lvlone"]]), + covnames = cvapply(names(info$lp[["M_lvlone"]]), + replace_trafo, + info$fcts_all), + trafo = info$fcts_all, isgk = FALSE) }), collapse = " + ") @@ -351,7 +356,10 @@ jagsmodel_jm <- function(info) { cols = info$lp[["M_lvlone"]], scale_pars = info$scale_pars[["M_lvlone"]], assoc_type = info$assoc_type, - covnames = names(info$lp[["M_lvlone"]]), + covnames = cvapply(names(info$lp[["M_lvlone"]]), + replace_trafo, + info$fcts_all), + trafo = info$fcts_all, isgk = TRUE) } ), collapse = " + "), diff --git a/R/get_model_info.R b/R/get_model_info.R index e4e5091f..e1a920b2 100644 --- a/R/get_model_info.R +++ b/R/get_model_info.R @@ -116,7 +116,7 @@ get_model1_info <- function(k, Mlist, par_index_main, par_index_other, # transformations ------------------------------------------------------------ trafos <- paste_trafos(Mlist, varname = k, - index = index[gsub("M_", "", resp_mat[1L])], + index = if (isgk) "ii" else index[gsub("M_", "", resp_mat[1L])], isgk = isgk) # JM settings ---------------------------------------------------------------- @@ -221,12 +221,15 @@ get_model1_info <- function(k, Mlist, par_index_main, par_index_other, assoc_type <- if (modeltype %in% "JM") { covrs <- unique(unlist(lapply(names(unlist(unname(lp))), replace_dummy, Mlist$refs))) - get_assoc_type(intersect(tvars, covrs), + covrs <- setNames(unlist(lapply(covrs, replace_trafo, Mlist$fcts_all)), + covrs) + + get_assoc_type(covrs[covrs %in% tvars], Mlist$models, assoc_type, Mlist$refs) } else if (modeltype %in% "coxph") { "obs.value" } else if (isTRUE(isgk)) { - get_assoc_type(k, Mlist$models, assoc_type, Mlist$refs) + get_assoc_type(setNames(k, k), Mlist$models, assoc_type, Mlist$refs) } # collect all info --------------------------------------------------------- @@ -256,6 +259,7 @@ get_model1_info <- function(k, Mlist, par_index_main, par_index_other, rd_vcov = rd_vcov, group_lvls = Mlist$group_lvls, trafos = trafos, + fcts_all = Mlist$fcts_all, trunc = trunc[[k]], custom = custom[[k]], ppc = FALSE, @@ -437,7 +441,7 @@ get_assoc_type <- function(covnames, models, assoc_type, refs) { fmlys <- lapply(models[covnames], get_family) assoc_type <- setNames(rep("obs.value", length(covnames)), - covnames) + names(covnames)) assoc_type[fmlys %in% c("gaussian", "Gamma", "lognorm", "beta")] <- "underl.value" diff --git a/R/helpfunctions_JAGSmodel.R b/R/helpfunctions_JAGSmodel.R index 12620196..37c948a3 100644 --- a/R/helpfunctions_JAGSmodel.R +++ b/R/helpfunctions_JAGSmodel.R @@ -706,7 +706,8 @@ rd_vcov_full <- function(nranef, nam) { # Joint model ------------------------------------------------------------------ paste_linpred_jm <- function(varname, parname, parelmts, matnam, index, cols, - scale_pars, assoc_type, covnames, isgk = FALSE) { + scale_pars, assoc_type, covnames, isgk = FALSE, + trafo = NULL) { # - varname: name of the survival outcome # - parname: name of the parameter, e.g. "beta" # - parelmts: vector specifying which elements of the parameter vector are @@ -732,8 +733,24 @@ paste_linpred_jm <- function(varname, parname, parelmts, matnam, index, cols, index = index, columns = cols, assoc_type = assoc_type, isgk = isgk) + # wrap in trafo if there is a trafo of the time-dep variable in the lin.pred + # of the survival model + if (!is.null(unlist(covnames))) { + pastedat <- Map(function(covname, colname, strng) { + if (colname %in% trafo$colname) { + fct <- trafo$fct[trafo$colname == colname] + if (trafo$type[trafo$colname == colname] == "I") { + fct <- gsub("\\)$", "", gsub("^I\\(", "", fct)) + } + gsub(pattern = covname, replacement = strng, x = fct) + } else { + strng + } + }, covname = covnames, colname = names(covnames), strng = pastedat) + } + paste( - paste_scaling(x = pastedat, + paste_scaling(x = unlist(pastedat), rows = cols, scale_pars = list(scale_pars)[rep(1, length(cols))], scalemat = rep(paste0("sp", matnam), length(cols))