changes to allow for non-linear functions of time-dependent covariate…

…s in the survival sub-model of a joint model

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"
   )
 }

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 = " + "),

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"
 

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))