Adding sccs_time_period table to export, capturing the calendar tim…

…e period included in the analysis. Handling edge case in `computeTimeStability()` when there is only 1 month.

NEWS.md

@@ -9,6 +9,12 @@ Changes
 
 3. Optimized `runSccsAnalyses()` to allow running bigger sets of analyses.
 
+4. Adding `sccs_time_period` table to export, capturing the calendar time period included in the analysis.
+
+Bugfixes
+
+1. Handling edge case in `computeTimeStability()` when there is only 1 month.
+
 
 SelfControlledCaseSeries 5.0.0
 ==============================

R/Diagnostics.R

@@ -154,8 +154,11 @@ computeTimeStability <- function(studyPopulation, sccsModel = NULL, maxRatio = 1
   checkmate::assertNumeric(alpha, lower = 0, upper = 1, len = 1, add = errorMessages)
   checkmate::reportAssertions(collection = errorMessages)
 
-  data <- computeOutcomeRatePerMonth(studyPopulation, sccsModel)
-  if (nrow(data) == 0) {
+  saveRDS(studyPopulation, "d:/temp/studyPopulation.rds")
+  saveRDS(sccsModel, "d:/temp/sccsModel.rds")
+
+  data <- SelfControlledCaseSeries:::computeOutcomeRatePerMonth(studyPopulation, sccsModel)
+  if (nrow(data) < 2) {
     result <- tibble(ratio = NA,
                      p = 1,
                      stable = TRUE)

R/Export.R

@@ -292,6 +292,7 @@ exportFromSccsDataStudyPopSccsModel <- function(outputFolder, exportFolder, data
   sccsSpline <- list()
   sccsTimeToEvent <- list()
   sccsTimeTrend <- list()
+  sccsTimePeriod <- list()
   sccsDiagnosticsSummary <- list()
 
   sccsDataFile <- ""
@@ -338,6 +339,24 @@ exportFromSccsDataStudyPopSccsModel <- function(outputFolder, exportFolder, data
         select("analysisId", "exposuresOutcomeSetId") %>%
         cross_join(timeSpans)
 
+      # time_period table
+      if (!is.null(studyPop$metaData$restrictedTimeToEra)) {
+        timePeriod <- studyPop$metaData$restrictedTimeToEra %>%
+          select(minDate = .data$minObservedDate,
+                 maxDate = .data$maxObservedDate)
+      } else {
+        timePeriod <- studyPop$cases %>%
+          mutate(startDate = .data$observationPeriodStartDate + .data$startDay,
+                 endDate = .data$observationPeriodStartDate + .data$endDay) %>%
+          summarise(minDate = min(startDate),
+                    maxDate = max(endDate))
+      }
+      refRows <- reference %>%
+        filter(.data$studyPopFile == !!studyPopFile)
+      sccsTimePeriod[[length(sccsCalendarTimeSpanning) + 1]] <- refRows %>%
+        select("analysisId", "exposuresOutcomeSetId") %>%
+        cross_join(timePeriod)
+
       # sccsEventDepObservation table
       data <- computeTimeToObsEnd(studyPop) %>%
         mutate(monthsToEnd = round(.data$daysFromEvent / 30.5)) %>%
@@ -666,13 +685,18 @@ exportFromSccsDataStudyPopSccsModel <- function(outputFolder, exportFolder, data
   fileName <- file.path(exportFolder, "sccs_attrition.csv")
   writeToCsv(sccsAttrition, fileName)
 
-  message("  Censoring sccs_age_spanning table")
+  message("  Censoring sccs_calendar_time_spanning table")
   sccsCalendarTimeSpanning <- sccsCalendarTimeSpanning %>%
     bind_rows() %>%
     enforceMinCellValue("coverBeforeAfterSubjects", minCellCount)
   fileName <- file.path(exportFolder, "sccs_calendar_time_spanning.csv")
   writeToCsv(sccsCalendarTimeSpanning, fileName)
 
+  sccsTimePeriod <- sccsTimePeriod %>%
+    bind_rows()
+  fileName <- file.path(exportFolder, "sccs_time_period.csv")
+  writeToCsv(sccsTimePeriod, fileName)
+
   sccsCovariate <- sccsCovariate %>%
     bind_rows() %>%
     distinct()