Rework link functions

DESCRIPTION

@@ -17,13 +17,13 @@ Description: Implements joint models combining a non-linear mixed effects model
     In phase 1 studies patients are followed until progression only. 
     Thus, reliable overall survival data and hence estimates are not available. 
     However, we can use additional information from previous clinical trials 
-    or real-world data - we can correlate the tumor response data, that are 
+    or real-world data - we can correlate the tumour response data, that are 
     longitudinal measurements, with the overall survival of the patients or their 
     hazard ratios. Thereby we can predict the overall survival from our phase 1 study
     data and therefore make better decisions.
 License: Apache License (>= 2)
 Encoding: UTF-8
-Language: en-US
+Language: en-GB
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.1
 Depends:
@@ -70,15 +70,13 @@ Collate:
     'ParameterList.R'
     'StanModel.R'
     'LongitudinalModel.R'
+    'LinkComponent.R'
     'Link.R'
     'SurvivalModel.R'
     'JointModel.R'
     'Quantities.R'
     'SurvivalQuantities.R'
     'JointModelSamples.R'
-    'LinkGSF.R'
-    'LinkNone.R'
-    'LinkRandomSlope.R'
     'LongitudinalGSF.R'
     'LongitudinalQuantities.R'
     'LongitudinalRandomSlope.R'

NAMESPACE

@@ -1,5 +1,8 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(as.StanModule,JointModel)
+S3method(as.StanModule,Link)
+S3method(as.StanModule,LinkComponent)
 S3method(as.StanModule,Parameter)
 S3method(as.StanModule,ParameterList)
 S3method(as.StanModule,Prior)
@@ -17,6 +20,8 @@ S3method(as.list,DataJoint)
 S3method(as.list,DataLongitudinal)
 S3method(as.list,DataSubject)
 S3method(as.list,DataSurvival)
+S3method(as.list,Link)
+S3method(as.list,LinkComponent)
 S3method(as.list,ParameterList)
 S3method(as.list,StanModel)
 S3method(as.list,StanModule)
@@ -25,7 +30,7 @@ S3method(as_print_string,DataSubject)
 S3method(as_print_string,DataSurvival)
 S3method(as_print_string,JointModelSamples)
 S3method(as_print_string,Link)
-S3method(as_print_string,LinkNone)
+S3method(as_print_string,LinkComponent)
 S3method(as_print_string,LongitudinalModel)
 S3method(as_print_string,LongitudinalQuantities)
 S3method(as_print_string,ParameterList)
@@ -47,16 +52,29 @@ S3method(autoplot,SurvivalQuantities)
 S3method(brierScore,SurvivalQuantities)
 S3method(compileStanModel,JointModel)
 S3method(dim,Quantities)
+S3method(enableLink,LongitudinalGSF)
+S3method(enableLink,LongitudinalRandomSlope)
 S3method(extractVariableNames,DataSubject)
 S3method(extractVariableNames,DataSurvival)
 S3method(generateQuantities,JointModelSamples)
-S3method(getParameters,default)
+S3method(getParameters,Link)
+S3method(getParameters,LinkComponent)
 S3method(initialValues,JointModel)
 S3method(initialValues,Link)
+S3method(initialValues,LinkComponent)
 S3method(initialValues,Parameter)
 S3method(initialValues,ParameterList)
 S3method(initialValues,Prior)
 S3method(initialValues,StanModel)
+S3method(length,Link)
+S3method(linkDSLD,LongitudinalGSF)
+S3method(linkDSLD,LongitudinalModel)
+S3method(linkDSLD,LongitudinalRandomSlope)
+S3method(linkIdentity,LongitudinalGSF)
+S3method(linkIdentity,LongitudinalModel)
+S3method(linkIdentity,LongitudinalRandomSlope)
+S3method(linkTTG,LongitudinalGSF)
+S3method(linkTTG,LongitudinalModel)
 S3method(names,Parameter)
 S3method(names,ParameterList)
 S3method(sampleStanModel,JointModel)
@@ -74,9 +92,7 @@ export(DataSubject)
 export(DataSurvival)
 export(JointModel)
 export(Link)
-export(LinkGSF)
-export(LinkNone)
-export(LinkRandomSlope)
+export(LinkComponent)
 export(LongitudinalGSF)
 export(LongitudinalModel)
 export(LongitudinalQuantities)
@@ -93,20 +109,23 @@ export(SurvivalLogLogistic)
 export(SurvivalModel)
 export(SurvivalQuantities)
 export(SurvivalWeibullPH)
-export(addLink)
 export(as_stan_list)
 export(autoplot)
 export(brierScore)
 export(compileStanModel)
+export(enableLink)
 export(generateQuantities)
 export(gsf_dsld)
 export(gsf_sld)
 export(gsf_ttg)
 export(initialValues)
-export(link_gsf_abstract)
-export(link_gsf_dsld)
-export(link_gsf_identity)
-export(link_gsf_ttg)
+export(linkDSLD)
+export(linkIdentity)
+export(linkTTG)
+export(link_dsld)
+export(link_identity)
+export(link_none)
+export(link_ttg)
 export(merge)
 export(prior_beta)
 export(prior_cauchy)
@@ -135,9 +154,6 @@ exportClasses(DataSurvival)
 exportClasses(JointModel)
 exportClasses(JointModelSamples)
 exportClasses(Link)
-exportClasses(LinkGSF)
-exportClasses(LinkNone)
-exportClasses(LinkRandomSlope)
 exportClasses(LongitudinalGSF)
 exportClasses(LongitudinalModel)
 exportClasses(LongitudinalRandomSlope)
@@ -150,10 +166,6 @@ exportClasses(SurvivalExponential)
 exportClasses(SurvivalLogLogistic)
 exportClasses(SurvivalModel)
 exportClasses(SurvivalWeibullPH)
-exportClasses(link_gsf_abstract)
-exportClasses(link_gsf_dsld)
-exportClasses(link_gsf_identity)
-exportClasses(link_gsf_ttg)
 exportMethods(show)
 import(assertthat)
 import(checkmate)

R/DataJoint.R

@@ -149,7 +149,7 @@ as_stan_list.DataJoint <- function(object, ...) {
         ))
 }
 
-#' @name as_stan_list.DataObject
+#' @rdname as_stan_list.DataObject
 #' @export
 as.list.DataJoint <- function(x, ...) {
     as_stan_list(x, ...)

R/DataLongitudinal.R

@@ -190,7 +190,7 @@ as_stan_list.DataLongitudinal <- function(object, subject_var, ...) {
     model_data <- list(
         Nta_total = nrow(df),
 
-        # Number of individuals and tumor assessments.
+        # Number of individuals and tumour assessments.
         Nta_obs_y = length(index_obs),
         Nta_cens_y = length(index_cen),
 
@@ -204,7 +204,7 @@ as_stan_list.DataLongitudinal <- function(object, subject_var, ...) {
         Ythreshold = adj_threshold,
 
         # Sparse matrix parameters
-        # Matrix of individuals x observed tumor assessments.
+        # Matrix of individuals x observed tumour assessments.
         n_mat_inds_obs_y = c(
             length(sparse_mat_inds_obs_y$w),
             length(sparse_mat_inds_obs_y$v),
@@ -214,7 +214,7 @@ as_stan_list.DataLongitudinal <- function(object, subject_var, ...) {
         v_mat_inds_obs_y = sparse_mat_inds_obs_y$v,
         u_mat_inds_obs_y = sparse_mat_inds_obs_y$u,
 
-        # Matrix of individuals x censored tumor assessments.
+        # Matrix of individuals x censored tumour assessments.
         n_mat_inds_cens_y = c(
             length(sparse_mat_inds_cens_y$w),
             length(sparse_mat_inds_cens_y$v),

R/JointModel.R

@@ -23,7 +23,6 @@ NULL
 NULL
 
 setClassUnion("LongitudinalModel_OR_NULL", c("LongitudinalModel", "NULL"))
-setClassUnion("Link_OR_NULL", c("Link", "NULL"))
 setClassUnion("SurvivalModel_OR_NULL", c("SurvivalModel", "NULL"))
 
 # JointModel-class ----
@@ -44,7 +43,7 @@ setClassUnion("SurvivalModel_OR_NULL", c("SurvivalModel", "NULL"))
     slots = list(
         longitudinal = "LongitudinalModel_OR_NULL",
         survival = "SurvivalModel_OR_NULL",
-        link = "Link_OR_NULL",
+        link = "Link",
         stan = "StanModule",
         parameters = "ParameterList"
     )
@@ -57,26 +56,40 @@ setClassUnion("SurvivalModel_OR_NULL", c("SurvivalModel", "NULL"))
 JointModel <- function(
     longitudinal = NULL,
     survival = NULL,
-    link = NULL
+    link = link_none()
 ) {
-    longitudinal_linked <- addLink(longitudinal, link)
 
-    parameters <- merge(
-        getParameters(longitudinal_linked),
-        getParameters(survival)
+    # Ensure that it is a link object (e.g. wrap link components in a Link object)
+    link <- Link(link)
+
+    if (length(link) > 0) {
+        longitudinal <- enableLink(longitudinal)
+    }
+
+    parameters <- Reduce(
+        merge,
+        list(
+            getParameters(longitudinal),
+            getParameters(survival),
+            getParameters(link)
+        )
     )
 
     base_model <- paste0(read_stan("base/base.stan"), collapse = "\n")
 
     stan_full <- decorated_render(
         .x = base_model,
-        longitudinal = add_missing_stan_blocks(as.list(longitudinal_linked)),
+        longitudinal = add_missing_stan_blocks(as.list(longitudinal)),
         survival = add_missing_stan_blocks(as.list(survival)),
-        priors = as.list(parameters),
-        link_none = class(link)[[1]] == "LinkNone" | is.null(link)
+        link = add_missing_stan_blocks(as.list(link, model = longitudinal)),
+        priors = add_missing_stan_blocks(as.list(parameters))
     )
-    # Resolve any lingering references from longitudinal / survival code
-    # that haven't yet been rendered
+    # Unresolved Jinja code within the longitudinal / Survival / Link
+    # models won't be resolved by the above call to `decorated_render`.
+    # Instead they it will just be inserted into the template asis. Thus
+    # we run `decorated_render` again to resolve any lingering Jinja code
+    # Main example being models that don't have any Jinja code but still
+    # use the `decorated_render` constants `machine_double_eps`.
     stan_full <- decorated_render(.x = stan_full)
 
     stan_complete <- merge(
@@ -94,6 +107,7 @@ JointModel <- function(
 }
 
 
+
 #' `JointModel` -> `character`
 #'
 #' Renders a [`JointModel`] object to a stan program
@@ -106,6 +120,20 @@ as.character.JointModel <- function(x, ...) {
 }
 
 
+#' `JointModel` -> `StanModule`
+#'
+#' Converts a [`JointModel`] object to a [`StanModule`] object
+#'
+#' @inheritParams JointModel-Shared
+#'
+#' @family JointModel
+#' @family as.StanModule
+#' @export
+as.StanModule.JointModel <- function(object, ...) {
+    object@stan
+}
+
+
 # write_stan-JointModel ----
 
 #' @rdname write_stan
@@ -266,11 +294,7 @@ setMethod(
             as_print_string(object@longitudinal) |> pad_with_white_space()
         }
 
-        link_string <- if (is.null(object@link) || inherits(object@link, "LinkNone")) {
-            "\n     No Link\n"
-        } else {
-            as_print_string(object@link) |> pad_with_white_space()
-        }
+        link_string <- as_print_string(object@link) |> pad_with_white_space()
 
         string <- "\nA Joint Model with:\n\n  Survival:%s\n  Longitudinal:%s\n  Link:%s\n"
         cat(sprintf(