Adds prepareData (#82)

Adds helper function to prepare simIDM trial data (both formats allowed)
to compute log-likelihood.

---------

Signed-off-by: Holger Löwe <64039523+holgstr@users.noreply.github.com>
Co-authored-by: Daniel Sabanes Bove <danielinteractive@users.noreply.github.com>

DESCRIPTION

@@ -25,6 +25,7 @@ Depends:
     R (>= 3.6)
 Imports:
     checkmate,
+    mstate,
     stats,
     survival
 Suggests:
@@ -33,11 +34,12 @@ Suggests:
     mvna,
     prodlim,
     rmarkdown,
-    testthat (>= 2.0)
+    testthat (>= 3.0.0)
 VignetteBuilder:
     knitr
 Encoding: UTF-8
 Language: en-US
 LazyData: true
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.2.3
+Config/testthat/edition: 3

NAMESPACE

@@ -36,6 +36,7 @@ export(integrateVector)
 export(logRankTest)
 export(passedLogRank)
 export(piecewise_exponential)
+export(prepareData)
 export(pwA)
 export(trackEventsPerTrial)
 export(weibull_transition)

NEWS.md

@@ -1,21 +1,24 @@
 # simIDM 0.0.5.9015
 
-### Bug Fixes
+### New Features
 
-- `ExpSurvOS` now returns 0 instead of NaN for large values of t.
-- `WeibSurvOS` now does not return an error for large values of t.
-- `getSimulatedData` now also works when there are no transitions from progression to death, similarly for `getOneClinicalTrial` (which now warns if there are no such transitions at all).
+-   `prepareData` allows formatting of trial data for log-likelihood computation.
+
+### Bug Fixes
 
+-   `ExpSurvOS` now returns 0 instead of NaN for large values of t.
+-   `WeibSurvOS` now does not return an error for large values of t.
+-   `getSimulatedData` now also works when there are no transitions from progression to death, similarly for `getOneClinicalTrial` (which now warns if there are no such transitions at all).
 
 # simIDM 0.0.5
 
-- First CRAN version of the package.
-- The package simulates illness-death models with constant, Weibull or piecewise constant transition hazards.
+-   First CRAN version of the package.
+-   The package simulates illness-death models with constant, Weibull or piecewise constant transition hazards.
 
 ### New Features
 
-- Exponentially, Weibull and piecewise exponentially distributed survival times.
-- Random censoring and event-driven censoring after a pre-specified number of PFS or OS events.
-- Arbitrary number of treatment arms and flexible randomization ratio.
-- Staggered study entry.
-- Derivation of PFS and OS survival functions from transition hazards.
+-   Exponentially, Weibull and piecewise exponentially distributed survival times.
+-   Random censoring and event-driven censoring after a pre-specified number of PFS or OS events.
+-   Arbitrary number of treatment arms and flexible randomization ratio.
+-   Staggered study entry.
+-   Derivation of PFS and OS survival functions from transition hazards.

R/estimateParams.R

@@ -0,0 +1,55 @@
+#' Preparation of a Data Set to Compute Log-likelihood
+#'
+#' @param data (`data.frame`)\cr containing entry and exit times of an illness-death model.
+#'   See [getOneClinicalTrial()] for details.
+#'
+#' @return This function returns a data set with one row per patient and transition, when the patient is at risk.
+#' @export
+#'
+#' @details
+#' The output data set contains the following columns:
+#' - id (`integer`): patient id.
+#' - from (`integer`): start event state.
+#' - to (`integer`): end event state.
+#' - trans (`integer`): transition (1, 2 or 3) identifier.
+#' - entry (`numeric`): time at which the patient begins to be at risk for the transition.
+#' - exit (`numeric`): time at which the patient ends to be at risk for the transition.
+#' - status (`logical`): event indicator for the transition.
+#'
+#' @examples
+#' transition <- exponential_transition(h01 = 1.2, h02 = 1.5, h12 = 1.6)
+#' simData <- getOneClinicalTrial(
+#'   nPat = c(30), transitionByArm = list(transition),
+#'   dropout = list(rate = 0.8, time = 12),
+#'   accrual = list(param = "time", value = 1)
+#' )
+#' prepareData(simData)
+prepareData <- function(data) {
+  assert_data_frame(data, min.cols = 9, max.cols = 11)
+  colNames <- c(
+    "id", "trt", "PFStime", "CensoredPFS", "PFSevent", "OStime",
+    "CensoredOS", "OSevent", "recruitTime",
+    "OStimeCal", "PFStimeCal"
+  )
+  if (!all(names(data) %in% colNames)) {
+    data <- getDatasetWideFormat(data)
+  }
+
+  # Transform simIDM trial data to log-likelihood-compatible format.
+  # Suppress warning about how msprep handles 1 -> 3 transitions.
+  dataNew <- suppressWarnings(mstate::msprep(
+    time = c("recruitTime", "PFStime", "OStime"),
+    status = c("trt", "PFSevent", "OSevent"),
+    data = data,
+    trans = mstate::trans.illdeath(),
+    id = data$id
+  ))
+  cols <- which(names(dataNew) %in% c("Tstart", "Tstop"))
+  names(dataNew)[cols] <- c("entry", "exit")
+  # Correct msprep results for uncensored PFS=OS events.
+  ids <- data$id[data$PFStimeCal == data$OStimeCal & data$CensoredPFS == 0]
+  dataNew <- dataNew[!(dataNew$id %in% ids & dataNew$trans == 3), ]
+  dataNew$status[dataNew$id %in% ids] <- abs(dataNew$status[dataNew$id %in% ids] - 1)
+
+  as.data.frame(dataNew[, -which(names(dataNew) == "time")], row.names = seq_len(nrow(dataNew)))
+}

_pkgdown.yaml

@@ -72,3 +72,6 @@ reference:
     contents:
       - logRankTest
       - empSignificant
+  - title: Parameter Estimation
+    contents:
+      - prepareData

tests/testthat.R

@@ -1,3 +1,12 @@
-pkg_name <- "simIDM"
-library(pkg_name, character.only = TRUE)
-testthat::test_check(pkg_name)
+# This file is part of the standard setup for testthat.
+# It is recommended that you do not modify it.
+#
+# Where should you do additional test configuration?
+# Learn more about the roles of various files in:
+# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview
+# * https://testthat.r-lib.org/articles/special-files.html
+
+library(testthat)
+library(simIDM)
+
+test_check("simIDM")

tests/testthat/_snaps/estimateParams.md

@@ -0,0 +1,17 @@
+# prepareData works as expected
+
+    Code
+      actual
+    Output
+         id from to trans entry exit status
+      1   1    1  2     1   0.0 0.20      0
+      2   1    1  3     2   0.0 0.20      0
+      3   2    1  2     1   0.0 0.70      1
+      4   2    1  3     2   0.0 0.70      0
+      5   2    2  3     3   0.7 0.80      0
+      6   3    1  2     1   0.0 0.40      0
+      7   3    1  3     2   0.0 0.40      1
+      8   4    1  2     1   0.0 0.10      1
+      9   4    1  3     2   0.0 0.10      0
+      10  4    2  3     3   0.1 0.25      1
+

tests/testthat/test-estimateParams.R

@@ -0,0 +1,16 @@
+# prepareData ----
+
+test_that("prepareData works as expected", {
+  # Create simIDM data for the 4 possible different transition scenarios.
+  colnames <- c(
+    "id", "trt", "PFStime", "CensoredPFS", "PFSevent", "OStime",
+    "CensoredOS", "OSevent", "recruitTime", "OStimeCal", "PFStimeCal"
+  )
+  patCens1 <- c(1, 1, 0.2, 1, 0, 0.2, 1, 0, 0.1, 0.3, 0.3)
+  patCens2 <- c(2, 1, 0.7, 0, 1, 0.8, 1, 0, 1.2, 2, 1.9)
+  pat13 <- c(3, 1, 0.4, 0, 1, 0.4, 0, 1, 0.4, 0.8, 0.8)
+  pat123 <- c(4, 1, 0.1, 0, 1, 0.25, 0, 1, 0, 0.25, 0.1)
+  df <- setNames(data.frame(rbind(patCens1, patCens2, pat13, pat123)), nm = colnames)
+  actual <- prepareData(df)
+  expect_snapshot(actual)
+})

tests/testthat/test-survivalFunctions.R

@@ -2,7 +2,7 @@
 
 test_that("ExpSurvPFS works as expected", {
   actual <- ExpSurvPFS(2, 0.3, 1.8)
-  expect_equal(actual, 0.01499558)
+  expect_equal(actual, 0.01499558, tolerance = 1e-3)
 
   actual2 <- ExpSurvPFS(0, 0.3, 1.8)
   expect_equal(actual2, 1)
@@ -67,13 +67,13 @@ test_that("pwA works as expected", {
 
 test_that("PWCsurvPFS works as expected", {
   actual <- PWCsurvPFS(1:3, c(0.7, 0.9), c(0.5, 1), c(0, 3), c(0, 7))
-  expect_equal(actual, ExpSurvPFS(1:3, 0.7, 0.5))
+  expect_equal(actual, ExpSurvPFS(1:3, 0.7, 0.5), tolerance = 1e-3)
 
   actual2 <- PWCsurvPFS(0, c(0.7, 0.9), c(0.5, 0.2), c(0, 9), c(0, 7))
   expect_equal(actual2, 1)
 
   actual3 <- PWCsurvPFS(2, c(0.7, 0.9), c(0.5, 0.2), c(0, 1), c(0, 0.8))
-  expect_equal(actual3, 0.1064585)
+  expect_equal(actual3, 0.1064585, tolerance = 1e-3)
 })
 
 # PWCsurvOS ----