Negative controls execution implements incremental mode

.github/workflows/R_CMD_check_Hades.yaml

@@ -58,7 +58,7 @@ jobs:
         with:
           r-version: ${{ matrix.config.r }}
           rtools-version: ${{ matrix.config.rtools }}
-
+          
       - uses: r-lib/actions/setup-tinytex@v2
 
       - uses: r-lib/actions/setup-pandoc@v2
@@ -91,6 +91,10 @@ jobs:
             eval sudo $cmd
           done < <(Rscript -e 'writeLines(remotes::system_requirements("ubuntu", "20.04"))')
 
+      - name: Reconfigure Java
+        if: runner.os == 'macOS'
+        run: R CMD javareconf
+
       - name: Install libssh
         if: runner.os == 'Linux'
         run: |    

R/NegativeControlCohorts.R

@@ -53,8 +53,8 @@ createEmptyNegativeControlOutcomeCohortSet <- function(verbose = FALSE) {
 #' @keywords internal
 .getNegativeControlOutcomeCohortSetSpecification <- function() {
   return(readCsv(system.file("negativeControlOutcomeCohortSetSpecificationDescription.csv",
-    package = "CohortGenerator",
-    mustWork = TRUE
+                             package = "CohortGenerator",
+                             mustWork = TRUE
   )))
 }
 
@@ -84,6 +84,10 @@ createEmptyNegativeControlOutcomeCohortSet <- function(verbose = FALSE) {
 #' @param detectOnDescendants     When set to TRUE, detectOnDescendants will use the vocabulary to find negative control
 #'                                outcomes using the outcomeConceptId and all descendants via the concept_ancestor table.
 #'                                When FALSE, only the exact outcomeConceptId will be used to detect the outcome.
+#' @param incremental             Create only cohorts that haven't been created before?
+#'
+#' @param incrementalFolder       If \code{incremental = TRUE}, specify a folder where records are
+#'                                kept of which definition has been executed.
 #'
 #' @return
 #' Invisibly returns an empty negative control outcome cohort set data.frame
@@ -97,6 +101,8 @@ generateNegativeControlOutcomeCohorts <- function(connectionDetails = NULL,
                                                   cohortTable = getCohortTableNames()$cohortTable,
                                                   negativeControlOutcomeCohortSet,
                                                   occurrenceType = "all",
+                                                  incremental = FALSE,
+                                                  incrementalFolder = NULL,
                                                   detectOnDescendants = FALSE) {
   if (is.null(connection) && is.null(connectionDetails)) {
     stop("You must provide either a database connection or the connection details.")
@@ -105,13 +111,36 @@ generateNegativeControlOutcomeCohorts <- function(connectionDetails = NULL,
   checkmate::assert_choice(x = tolower(occurrenceType), choices = c("all", "first"))
   checkmate::assert_logical(detectOnDescendants)
   checkmate::assertNames(colnames(negativeControlOutcomeCohortSet),
-    must.include = .getNegativeControlOutcomeCohortSetSpecification()$columnName
+                         must.include = .getNegativeControlOutcomeCohortSetSpecification()$columnName
   )
   checkmate::assert_data_frame(
     x = negativeControlOutcomeCohortSet,
     min.rows = 1
   )
 
+  if (incremental) {
+    if (is.null(incrementalFolder)) {
+      stop("Must specify incrementalFolder when incremental = TRUE")
+    }
+    if (!file.exists(incrementalFolder)) {
+      dir.create(incrementalFolder, recursive = TRUE)
+    }
+
+    recordKeepingFile <- file.path(incrementalFolder, "GeneratedNegativeControls.csv")
+    checksum <- computeChecksum(jsonlite::toJSON(
+      list(
+        negativeControlOutcomeCohortSet = negativeControlOutcomeCohortSet,
+        occurrenceType = occurrenceType,
+        detectOnDescendants = detectOnDescendants
+      )
+    ))[[1]]
+
+    if (!isTaskRequired(paramHash = checksum, checksum = checksum, recordKeepingFile = recordKeepingFile)) {
+      writeLines("Negative control set skipped")
+      return(invisible("SKIPPED"))
+    }
+  }
+
   start <- Sys.time()
   if (is.null(connection)) {
     connection <- DatabaseConnector::connect(connectionDetails)
@@ -159,6 +188,16 @@ generateNegativeControlOutcomeCohorts <- function(connectionDetails = NULL,
   )
   delta <- Sys.time() - start
   writeLines(paste("Generating negative control outcomes set took", round(delta, 2), attr(delta, "units")))
+
+  if (incremental) {
+    recordTasksDone(
+      paramHash = checksum,
+      checksum = checksum,
+      recordKeepingFile = recordKeepingFile
+    )
+  }
+
+  invisible("FINISHED")
 }
 
 createNegativeControlOutcomesQuery <- function(connection,

tests/testthat/test-NegativeControlCohorts.R

@@ -146,3 +146,137 @@ test_that("Call generateNegativeControlOutcomeCohorts with custom cohort ids", {
   )
   expect_equal(cohortCounts$cohortId, ncSet$cohortId)
 })
+
+
+test_that("Call generateNegativeControlOutcomeCohorts with occurrenceType == 'first' and detectOnDescendants == FALSE", {
+  cohortTableNames <- getCohortTableNames(cohortTable = "ot_first_dod_f")
+  connection <- DatabaseConnector::connect(connectionDetails = connectionDetails)
+  on.exit(DatabaseConnector::disconnect(connection))
+  createCohortTables(
+    connection = connection,
+    cohortDatabaseSchema = "main",
+    cohortTableNames = cohortTableNames
+  )
+  ncSet <- getNegativeControlOutcomeCohortsForTest()
+  expect_output(
+    generateNegativeControlOutcomeCohorts(
+      connection = connection,
+      cdmDatabaseSchema = "main",
+      cohortDatabaseSchema = "main",
+      cohortTable = cohortTableNames$cohortTable,
+      negativeControlOutcomeCohortSet = ncSet,
+      occurrenceType = "first",
+      detectOnDescendants = FALSE
+    )
+  )
+})
+
+
+test_that("incremental mode", {
+  incrementalFolder <- tempfile()
+  on.exit(unlink(incrementalFolder, recursive = TRUE, force = TRUE))
+  cohortTableNames <- getCohortTableNames(cohortTable = "nc_custom_cohortid")
+  connection <- DatabaseConnector::connect(connectionDetails = connectionDetails)
+  on.exit(DatabaseConnector::disconnect(connection), add = TRUE)
+  createCohortTables(
+    connection = connection,
+    cohortDatabaseSchema = "main",
+    cohortTableNames = cohortTableNames
+  )
+  ncSet <- getNegativeControlOutcomeCohortsForTest(setCohortIdToConceptId = FALSE)
+  res <- generateNegativeControlOutcomeCohorts(
+    connection = connection,
+    cdmDatabaseSchema = "main",
+    cohortDatabaseSchema = "main",
+    cohortTable = cohortTableNames$cohortTable,
+    negativeControlOutcomeCohortSet = ncSet,
+    occurrenceType = "first",
+    detectOnDescendants = TRUE,
+    incrementalFolder = incrementalFolder,
+    incremental = TRUE
+  )
+
+  expect_equal(res, "FINISHED")
+  checkmate::expect_file_exists(file.path(incrementalFolder, "GeneratedNegativeControls.csv"))
+  cohortCounts <- getCohortCounts(
+    connection = connection,
+    cohortDatabaseSchema = "main",
+    cohortTable = cohortTableNames$cohortTable
+  )
+  expect_equal(cohortCounts$cohortId, ncSet$cohortId)
+
+  res <- generateNegativeControlOutcomeCohorts(
+    connection = connection,
+    cdmDatabaseSchema = "main",
+    cohortDatabaseSchema = "main",
+    cohortTable = cohortTableNames$cohortTable,
+    negativeControlOutcomeCohortSet = ncSet,
+    occurrenceType = "first",
+    detectOnDescendants = TRUE,
+    incrementalFolder = incrementalFolder,
+    incremental = TRUE
+  )
+
+  expect_equal(res, "SKIPPED")
+
+  # Test changing other params regenerates
+  res <- generateNegativeControlOutcomeCohorts(
+    connection = connection,
+    cdmDatabaseSchema = "main",
+    cohortDatabaseSchema = "main",
+    cohortTable = cohortTableNames$cohortTable,
+    negativeControlOutcomeCohortSet = ncSet,
+    occurrenceType = "first",
+    detectOnDescendants = FALSE,
+    incrementalFolder = incrementalFolder,
+    incremental = TRUE
+  )
+
+  expect_equal(res, "FINISHED")
+
+  # Test changing other params regenerates
+  res <- generateNegativeControlOutcomeCohorts(
+    connection = connection,
+    cdmDatabaseSchema = "main",
+    cohortDatabaseSchema = "main",
+    cohortTable = cohortTableNames$cohortTable,
+    negativeControlOutcomeCohortSet = ncSet,
+    occurrenceType = "first",
+    detectOnDescendants = FALSE,
+    incrementalFolder = incrementalFolder,
+    incremental = TRUE
+  )
+
+  expect_equal(res, "SKIPPED")
+
+
+  res <- generateNegativeControlOutcomeCohorts(
+    connection = connection,
+    cdmDatabaseSchema = "main",
+    cohortDatabaseSchema = "main",
+    cohortTable = cohortTableNames$cohortTable,
+    negativeControlOutcomeCohortSet = ncSet,
+    occurrenceType = "all",
+    detectOnDescendants = FALSE,
+    incrementalFolder = incrementalFolder,
+    incremental = TRUE
+  )
+
+  expect_equal(res, "FINISHED")
+
+
+  res <- generateNegativeControlOutcomeCohorts(
+    connection = connection,
+    cdmDatabaseSchema = "main",
+    cohortDatabaseSchema = "main",
+    cohortTable = cohortTableNames$cohortTable,
+    negativeControlOutcomeCohortSet = ncSet,
+    occurrenceType = "all",
+    detectOnDescendants = FALSE,
+    incrementalFolder = incrementalFolder,
+    incremental = TRUE
+  )
+
+  expect_equal(res, "SKIPPED")
+
+})