Adding option to simulate monotonic calender time effects

R/Simulation.R

@@ -92,6 +92,7 @@ createSimulationRiskWindow <- function(start = 0,
 #' @param seasonKnots                 Number of knots in the seasonality spline.
 #' @param includeCalendarTimeEffect   Include a calendar time effect for the outcome?
 #' @param calendarTimeKnots           Number of knots in the calendar time spline.
+#' @param calenderTimeMonotonic       Should the calender time effect be monotonic?
 #' @param outcomeId                   The ID to be used for the outcome.
 #'
 #' @return
@@ -122,6 +123,7 @@ createSccsSimulationSettings <- function(meanPatientTime = 4 * 365,
                                          seasonKnots = 5,
                                          includeCalendarTimeEffect = TRUE,
                                          calendarTimeKnots = 5,
+                                         calenderTimeMonotonic = FALSE,
                                          outcomeId = 10) {
   errorMessages <- checkmate::makeAssertCollection()
   checkmate::assertNumeric(meanPatientTime, lower = 0, len = 1, add = errorMessages)
@@ -148,6 +150,7 @@ createSccsSimulationSettings <- function(meanPatientTime = 4 * 365,
   checkmate::assertInt(seasonKnots, lower = 2, add = errorMessages)
   checkmate::assertLogical(includeCalendarTimeEffect, len = 1, add = errorMessages)
   checkmate::assertInt(calendarTimeKnots, lower = 2, add = errorMessages)
+  checkmate::assertLogical(calenderTimeMonotonic, len = 1, add = errorMessages)
   checkmate::assertInt(outcomeId, add = errorMessages)
   checkmate::reportAssertions(collection = errorMessages)
 
@@ -397,6 +400,13 @@ simulateSccsData <- function(nCases, settings) {
   if (settings$includeCalendarTimeEffect) {
     calendarTime <- seq(settings$minCalendarTime, settings$maxCalendarTime, length.out = settings$calendarTimeKnots)
     calendarTimeRisk <- runif(settings$calendarTimeKnots, -2, 2)
+    if (settings$calenderTimeMonotonic) {
+      increasing <- calendarTimeRisk[1] > 0
+      calendarTimeRisk <- cumsum(abs(calendarTimeRisk))
+      if (!increasing) {
+        calendarTimeRisk <- -calendarTimeRisk
+      }
+    }
     calendarTimeFun <- splinefun(as.numeric(calendarTime), calendarTimeRisk)
   } else {
     calendarTimeFun <- NULL