Merge 23ca34b into 950498b

DESCRIPTION

@@ -71,6 +71,7 @@ Collate:
     'DataJoint.R'
     'Grid.R'
     'GridEven.R'
+    'GridEvent.R'
     'GridFixed.R'
     'GridGrouped.R'
     'GridManual.R'

NAMESPACE

@@ -2,13 +2,15 @@
 
 S3method(as.CmdStanMCMC,JointModelSamples)
 S3method(as.QuantityCollapser,GridEven)
+S3method(as.QuantityCollapser,GridEvent)
 S3method(as.QuantityCollapser,GridFixed)
 S3method(as.QuantityCollapser,GridGrouped)
 S3method(as.QuantityCollapser,GridManual)
 S3method(as.QuantityCollapser,GridObserved)
 S3method(as.QuantityCollapser,GridPopulation)
 S3method(as.QuantityCollapser,GridPrediction)
 S3method(as.QuantityGenerator,GridEven)
+S3method(as.QuantityGenerator,GridEvent)
 S3method(as.QuantityGenerator,GridFixed)
 S3method(as.QuantityGenerator,GridGrouped)
 S3method(as.QuantityGenerator,GridManual)
@@ -37,6 +39,7 @@ S3method(as.list,DataLongitudinal)
 S3method(as.list,DataSubject)
 S3method(as.list,DataSurvival)
 S3method(as.list,GridEven)
+S3method(as.list,GridEvent)
 S3method(as.list,GridFixed)
 S3method(as.list,GridGrouped)
 S3method(as.list,GridManual)
@@ -152,6 +155,7 @@ export(DataLongitudinal)
 export(DataSubject)
 export(DataSurvival)
 export(GridEven)
+export(GridEvent)
 export(GridFixed)
 export(GridGrouped)
 export(GridManual)

R/Grid.R

@@ -42,6 +42,9 @@
 #' - `GridEven()` generates quantities for each subject at N evenly spaced timepoints
 #' between each subjects first and last longitudinal observations.
 #'
+#' - `GridEvent()` generates one quantity for each subject at their event/censor time
+#' as indicated by the `time` variable in the survival dataset.
+#'
 #' - `GridPopulation()` generates longitudinal model quantities based on the population parameters at the
 #' specified time points. Generates 1 set of quantities for each distinct combination of `arm`
 #' and `study` within the [`DataSubject`] object provided to the [`JointModel`].

R/GridEvent.R

@@ -0,0 +1,54 @@
+#' @include Grid.R
+#' @include generics.R
+NULL
+
+#' @rdname Grid-Dev
+.GridEvent <- setClass(
+    "GridEvent",
+    contains = "Grid",
+    slots = c(
+        "subjects" = "character_or_NULL"
+    )
+)
+
+
+#' @rdname Grid-Functions
+#' @export
+GridEvent <- function(subjects = NULL) {
+    .GridEvent(
+        subjects = subjects
+    )
+}
+
+#' @rdname Quant-Dev
+#' @export
+as.QuantityGenerator.GridEvent <- function(object, data, ...) {
+    assert_class(data, "DataJoint")
+    assert_that(
+        !is.null(data@survival),
+        msg = "Survival data must have been provided to `DataJoint()` in order to use `GridEvent()`"
+    )
+    data_list <- as.list(data)
+    subjects <- unlist(as.list(object, data = data), use.names = FALSE)
+    event_times <- data_list$event_times[data_list$subject_to_index[subjects]]
+    QuantityGeneratorSubject(
+        times = event_times,
+        subjects = subjects
+    )
+}
+
+#' @rdname Quant-Dev
+#' @export
+as.QuantityCollapser.GridEvent <- 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.GridEvent <- function(x, data, ...) {
+    subjects_to_list(x@subjects, data)
+}

tests/testthat/test-Grid.R

@@ -208,7 +208,7 @@ test_that("Grid objects work with QuantityGenerator and QuantityCollapser", {
         subject = c("A", "B", "C", "D"),
         arm = c("Arm-A", "Arm-A", "Arm-B", "Arm-B"),
         study = c("Study-1", "Study-1", "Study-1", "Study-1"),
-        time = c(1, 2, 3, 4),
+        time = c(110, 220, 42, 302),
         event = c(1, 1, 0, 1)
     )
 
@@ -357,6 +357,63 @@ test_that("Grid objects work with QuantityGenerator and QuantityCollapser", {
     )
     expect_equal(actual, expected)
 
+
+    #
+    # GridEvent
+    #
+    grid <- GridEvent(
+        subjects = c("D", "A", "B")
+    )
+    # Simple comparisons against an identical grid manual
+    grid_man <- GridManual(
+        spec = list(
+            "D" = 302,
+            "A" = 110,
+            "B" = 220
+        )
+    )
+    actual <- as.QuantityGenerator(grid, data = dj)
+    expected <- QuantityGeneratorSubject(
+        subjects = c("D", "A", "B"),
+        times = c(302, 110, 220)
+    )
+    expect_equal(actual, expected)
+    expect_equal(
+        actual,
+        as.QuantityGenerator(grid_man, data = dj)
+    )
+
+    actual <- as.QuantityCollapser(grid, data = dj)
+    expected <- QuantityCollapser(
+        groups = expected@subjects,
+        times = expected@times,
+        indexes = list(1, 2, 3)
+    )
+    expect_equal(actual, expected)
+    expect_equal(
+        actual,
+        as.QuantityCollapser(grid_man, data = dj)
+    )
+
+    # Check that GridEvent errors if no survival data has been provided
+    dj2 <- DataJoint(
+        subject = DataSubject(
+            data = dat_os,
+            subject = "subject",
+            arm = "arm",
+            study = "study"
+        ),
+        longitudinal = DataLongitudinal(
+            data = dat_lm,
+            formula = sld ~ time,
+            threshold = 5
+        )
+    )
+    expect_error(
+        as.QuantityGenerator(grid, data = dj2),
+        regexp = "`GridEvent\\(\\)`"
+    )
+
 })