Added GridEven and GridManual

DESCRIPTION

@@ -67,8 +67,10 @@ Collate:
     'DataSurvival.R'
     'DataJoint.R'
     'Grid.R'
+    'GridEven.R'
     'GridFixed.R'
     'GridGrouped.R'
+    'GridManual.R'
     'GridObserved.R'
     'constants.R'
     'StanModule.R'

NAMESPACE

@@ -1,11 +1,15 @@
 # Generated by roxygen2: do not edit by hand
 
 S3method(as.CmdStanMCMC,JointModelSamples)
+S3method(as.QuantityCollapser,GridEven)
 S3method(as.QuantityCollapser,GridFixed)
 S3method(as.QuantityCollapser,GridGrouped)
+S3method(as.QuantityCollapser,GridManual)
 S3method(as.QuantityCollapser,GridObserved)
+S3method(as.QuantityGenerator,GridEven)
 S3method(as.QuantityGenerator,GridFixed)
 S3method(as.QuantityGenerator,GridGrouped)
+S3method(as.QuantityGenerator,GridManual)
 S3method(as.QuantityGenerator,GridObserved)
 S3method(as.StanModule,JointModel)
 S3method(as.StanModule,Link)
@@ -27,8 +31,10 @@ S3method(as.list,DataJoint)
 S3method(as.list,DataLongitudinal)
 S3method(as.list,DataSubject)
 S3method(as.list,DataSurvival)
+S3method(as.list,GridEven)
 S3method(as.list,GridFixed)
 S3method(as.list,GridGrouped)
+S3method(as.list,GridManual)
 S3method(as.list,GridObserved)
 S3method(as.list,Link)
 S3method(as.list,LinkComponent)
@@ -113,8 +119,10 @@ export(DataJoint)
 export(DataLongitudinal)
 export(DataSubject)
 export(DataSurvival)
+export(GridEven)
 export(GridFixed)
 export(GridGrouped)
+export(GridManual)
 export(GridObserved)
 export(JointModel)
 export(Link)

R/DataJoint.R

@@ -188,7 +188,7 @@ subset.DataJoint <- function(x, patients, ...) {
     dat <- data.frame(
         time = data[["event_times"]],
         event = as.numeric(seq_along(data[["event_times"]]) %in% data[["subject_event_index"]]),
-        patient = names(data[["pt_to_ind"]])
+        patient = names(data[["subject_to_index"]])
     )
     subset_and_add_grouping(dat, patients)
 }
@@ -246,7 +246,7 @@ extract_observed_values <- function(object) {
     assert_class(object, "DataJoint")
     data <- as.list(object)
     x <- data.frame(
-        subject = names(data$pt_to_ind)[data$subject_tumour_index],
+        subject = names(data$subject_to_index)[data$subject_tumour_index],
         time = data$tumour_time,
         Yob = data$tumour_value
     )

R/DataSubject.R

@@ -111,7 +111,7 @@ as_stan_list.DataSubject <- function(object, ...) {
         n_arms = length(unique(df[[vars$arm]])),
         subject_study_index = as.numeric(df[[vars$study]]),
         subject_arm_index = as.numeric(df[[vars$arm]]),
-        pt_to_ind = stats::setNames(
+        subject_to_index = stats::setNames(
             seq_len(nlevels(df[[vars$subject]])),
             levels(df[[vars$subject]])
         )

R/Grid.R

@@ -7,11 +7,30 @@
 #' If `NULL` will default to 201 evenly spaced timepoints between 0 and either the max
 #' observation time (for [`LongitudinalQuantities`]) or max event time (for [`SurvivalQuantities`]).
 #' @param groups (`list`)\cr named list of subjects to extract quantities for. See Group Specification.
-#'
+#' @param spec (`list`)\cr named list of subjects to extract quantities for. The names of each
+#' element should be the required subjects with the element itself being a numeric vector of timepoints
+#' to generate the quantity at.
+#' @param length.out (`numeric`)\cr number of evenly spaced timepoints to generate quantities at.
 #' @description
 #' These functions are used to specify which subjects and timepoints should be generated
 #' when calculating quantities via [`SurvivalQuantities`] and [`LongitudinalQuantities`].
 #'
+#' @details
+#'
+#' - `GridFixed()` is used to specify a fixed set of timepoints to generate quantities at for
+#' all the specified subjects.
+#'
+#' - `GridGrouped()` is similar to `GridFixed()` but allows for groupwise averaging
+#' (see Group Specification).
+#'
+#' - `GridObserved()` generates quantities at the observed longitudinal timepoints for each
+#' subject.
+#'
+#' - `GridManual()` allows for individual timepoint specification for each subject.
+#'
+#' - `GridEven()` generates quantities for each subject at N evenly spaced timepoints
+#' between each subjects first and last longitudinal observations.
+#'
 #' @section Group Specification:
 #' For `GridGrouped()`, `groups` must be a named list of character vectors. Each element of the list
 #' must be a character vector of the subjects that will form the group where the element name
@@ -163,3 +182,24 @@ setValidity(
 length.QuantityCollapser <- function(x) {
     length(x@indexes)
 }
+
+
+expand_null_subs_to_all_subs <- function(x, data, ...) {
+    data_list <- as.list(data)
+    subjects <- if (is.null(x@subjects)) {
+        subs <- as.list(names(data_list$subject_to_index))
+        names(subs) <- names(data_list$subject_to_index)
+        subs
+    } else {
+        subs <- as.list(x@subjects)
+        names(subs) <- x@subjects
+        subs
+    }
+    assert_that(
+        identical(
+            unlist(subjects, use.names = FALSE),
+            unique(unlist(subjects, use.names = FALSE))
+        )
+    )
+    subjects
+}

R/GridEven.R

@@ -0,0 +1,82 @@
+
+#' @include Grid.R
+#' @include generics.R
+NULL
+
+
+#' @rdname Grid-Dev
+.GridEven <- setClass(
+    "GridEven",
+    contains = "Grid",
+    slots = c(
+        "subjects" = "character",
+        "length.out" = "numeric"
+    )
+)
+
+
+#' @rdname Grid-Functions
+#' @export
+GridEven <- function(subjects = NULL, length.out = 30) {
+    .GridEven(
+        subjects = subjects,
+        length.out = length.out
+    )
+}
+
+
+setValidity(
+    "GridEven",
+    function(object) {
+        if (length([email protected]) != 1 || all([email protected] <= 0)) {
+            return("The `length.out` argument must be a positive integer")
+        }
+    }
+)
+
+
+#' @rdname Quant-Dev
+#' @export
+as.QuantityGenerator.GridEven <- function(object, data, ...) {
+    assert_class(data, "DataJoint")
+    data_list <- as.list(data)
+    subjects <- unlist(as.list(object, data = data), use.names = FALSE)
+    assert_that(
+        all(subjects %in% names(data_list$subject_to_index)),
+        msg = "All subject names must be in the `DataSubject` object"
+    )
+
+    spec <- lapply(
+        subjects,
+        \(sub) {
+            subject_index <- data_list$subject_to_index[[sub]]
+            time_index <- data_list$subject_tumour_index == subject_index
+            subject_times <- data_list$tumour_time[time_index]
+            seq(min(subject_times), max(subject_times), length.out = [email protected])
+        }
+    )
+    names(spec) <- subjects
+
+    as.QuantityGenerator(
+        GridManual(spec),
+        data = data
+    )
+}
+
+
+#' @rdname Quant-Dev
+#' @export
+as.QuantityCollapser.GridEven <- function(object, data, ...) {
+    generator <- as.QuantityGenerator(object, data)
+    QuantityCollapser(
+        times = generator@times,
+        groups = generator@subjects,
+        indexes = as.list(seq_along(generator@times))
+    )
+}
+
+
+#' @export
+as.list.GridEven <- function(x, data, ...) {
+    expand_null_subs_to_all_subs(x, data, ...)
+}

R/GridFixed.R

@@ -56,21 +56,5 @@ as.QuantityCollapser.GridFixed <- function(object, data, ...) {
 
 #' @export
 as.list.GridFixed <- function(x, data, ...) {
-    data_list <- as.list(data)
-    subjects <- if (is.null(x@subjects)) {
-        subs <- as.list(names(data_list$pt_to_ind))
-        names(subs) <- names(data_list$pt_to_ind)
-        subs
-    } else {
-        subs <- as.list(x@subjects)
-        names(subs) <- x@subjects
-        subs
-    }
-    assert_that(
-        identical(
-            unlist(subjects, use.names = FALSE),
-            unique(unlist(subjects, use.names = FALSE))
-        )
-    )
-    subjects
+    expand_null_subs_to_all_subs(x, data, ...)
 }

R/GridGrouped.R

@@ -46,7 +46,7 @@ as.QuantityGenerator.GridGrouped <- function(object, data, ...) {
     data_list <- as.list(data)
     patients_unique <- unique(unlist(object@groups))
     assert_that(
-        all(patients_unique %in% names(data_list$pt_to_ind))
+        all(patients_unique %in% names(data_list$subject_to_index))
     )
     as.QuantityGenerator(
         GridFixed(
@@ -64,7 +64,7 @@ as.QuantityCollapser.GridGrouped <- function(object, data, ...) {
     assert_class(data, "DataJoint")
     data_list <- as.list(data)
     assert_that(
-        all(unique(unlist(object@groups)) %in% names(data_list$pt_to_ind))
+        all(unique(unlist(object@groups)) %in% names(data_list$subject_to_index))
     )
     time_grid <- expand_time_grid(object@times, max(data_list[["tumour_time"]]))
 

R/GridManual.R

@@ -0,0 +1,81 @@
+
+#' @include Grid.R
+#' @include generics.R
+NULL
+
+
+#' @rdname Grid-Dev
+.GridManual <- setClass(
+    "GridManual",
+    contains = "Grid",
+    slots = c(
+        "spec" = "list"
+    )
+)
+
+
+#' @rdname Grid-Functions
+#' @export
+GridManual <- function(spec) {
+    .GridManual(
+        spec = spec
+    )
+}
+
+
+setValidity(
+    "GridManual",
+    function(object) {
+        subject_names <- names(object@spec)
+        subject_names_valid <- subject_names[!is.na(subject_names) & subject_names != ""]
+        if (length(subject_names_valid) != length(object@spec)) {
+            return("Each element of `subjects` must be named")
+        }
+        for (times in object@spec) {
+            if (!is.numeric(times)) {
+                return("Each element of `spec` must be a numeric vector")
+            }
+            if (length(times) != length(unique(times))) {
+                return("Each time vector per subject must be unique")
+            }
+        }
+        return(TRUE)
+    }
+)
+
+
+#' @rdname Quant-Dev
+#' @export
+as.QuantityGenerator.GridManual <- function(object, data, ...) {
+    assert_class(data, "DataJoint")
+    data_list <- as.list(data)
+    assert_that(
+        all(names(object@spec) %in% names(data_list$subject_to_index)),
+        msg = "All subject names must be in the `DataSubject` object"
+    )
+    lens <- vapply(object@spec, length, numeric(1))
+    .QuantityGenerator(
+        times = unlist(object@spec, use.names = FALSE),
+        subjects = rep(names(object@spec), lens)
+    )
+}
+
+
+#' @rdname Quant-Dev
+#' @export
+as.QuantityCollapser.GridManual <- function(object, data, ...) {
+    generator <- as.QuantityGenerator(object, data)
+    QuantityCollapser(
+        times = generator@times,
+        groups = generator@subjects,
+        indexes = as.list(seq_along(generator@times))
+    )
+}
+
+
+#' @export
+as.list.GridManual <- function(x, data, ...) {
+    subs <- as.list(names(x@spec))
+    names(subs) <- names(x@spec)
+    subs
+}

R/GridObserved.R

@@ -27,7 +27,7 @@ as.QuantityGenerator.GridObserved <- function(object, data, ...) {
     data_list <- as.list(data)
     subjects <- unlist(as.list(object, data = data), use.names = FALSE)
     unique_visits <- tapply(data_list$tumour_time, data_list$subject_tumour_index, unique)
-    patient_visits <- unique_visits[data_list$pt_to_ind[subjects]]
+    patient_visits <- unique_visits[data_list$subject_to_index[subjects]]
     visit_lengths <- vapply(patient_visits, length, numeric(1))
     .QuantityGenerator(
         times = unlist(patient_visits, use.names = FALSE),
@@ -49,21 +49,5 @@ as.QuantityCollapser.GridObserved <- function(object, data, ...) {
 
 #' @export
 as.list.GridObserved <- function(x, data, ...) {
-    data_list <- as.list(data)
-    subjects <- if (is.null(x@subjects)) {
-        subs <- as.list(names(data_list$pt_to_ind))
-        names(subs) <- names(data_list$pt_to_ind)
-        subs
-    } else {
-        subs <- as.list(x@subjects)
-        names(subs) <- x@subjects
-        subs
-    }
-    assert_that(
-        identical(
-            unlist(subjects, use.names = FALSE),
-            unique(unlist(subjects, use.names = FALSE))
-        )
-    )
-    subjects
+    expand_null_subs_to_all_subs(x, data, ...)
 }

R/JointModelSamples.R

@@ -46,7 +46,7 @@ generateQuantities.JointModelSamples <- function(object, generator, type, ...) {
         length(type) == 1,
         type %in% c("survival", "longitudinal"),
         length(patients) == length(times),
-        all(patients %in% names(data$pt_to_ind))
+        all(patients %in% names(data$subject_to_index))
     )
 
     if (type == "survival") {
@@ -58,7 +58,7 @@ generateQuantities.JointModelSamples <- function(object, generator, type, ...) {
     }
 
     data[["gq_n_quant"]] <- length(patients)
-    data[["gq_pt_index"]] <- data$pt_to_ind[as.character(patients)]
+    data[["gq_pt_index"]] <- data$subject_to_index[as.character(patients)]
     data[["gq_times"]] <- times
 
     stanObject <- object@model@stan

inst/WORDLIST

@@ -137,3 +137,4 @@ SimLongitudinal
 SimSurvival
 geq
 LLoQ
+groupwise