Add modulesToExecute to results data model creation and upload

OHDSI · Jan 17, 2025 · a1da50e · a1da50e
1 parent 6c06768
commit a1da50e
Show file tree

Hide file tree

Showing 5 changed files with 90 additions and 52 deletions.
diff --git a/R/Execution.R b/R/Execution.R
@@ -96,53 +96,10 @@ execute <- function(analysisSpecifications,
   # modulesToExecute are present in the analysis specification
   # before attempting to subset the analyses to run.
   if (length(executionSettings$modulesToExecute) > 0) {
-    # Get the modules in the analysis specification with their
-    # index in the array
-    modulesWithIndex <- lapply(
-      X = seq_along(analysisSpecifications$moduleSpecifications),
-      FUN = function(i) {
-        list(
-          idx = i,
-          module = analysisSpecifications$moduleSpecifications[[i]]$module
-        )
-      }
-    )
-    modulesInAnalysisSpecification <- sapply(
-      X = modulesWithIndex,
-      FUN = function(x) {
-        x$module
-      }
-    )
-
-    modulesToExecuteString <- paste(executionSettings$modulesToExecute, collapse = ", ")
-    modulesInAnalysisSpecificationString <- paste(modulesInAnalysisSpecification, collapse = ", ")
-
-    # Stop if we cannot find all of the requested modules
-    # to execute in the overall analysis specification
-    if (!all(tolower(executionSettings$modulesToExecute) %in% tolower(modulesInAnalysisSpecification))) {
-      errorMsg <- paste0(
-        "The executionSettings specified to run only the modules: ",
-        modulesToExecuteString,
-        ".\n However the analysis specification includes the following modules: ",
-        modulesInAnalysisSpecificationString
-      )
-      stop(errorMsg)
-    }
-
-    # Subset the analysis specifications to those modules
-    # specified by the user
-    cli::cli_alert_info(paste0("Runnning a subset of modules: ", modulesToExecuteString))
-    moduleSubset <- unlist(
-      lapply(
-        X = modulesWithIndex,
-        FUN = function(x) {
-          if (tolower(x$module) %in% tolower(executionSettings$modulesToExecute)) {
-            return(x$idx)
-          }
-        }
-      )
+    analysisSpecifications <- .subsetAnalysisSpecificationByModulesToExecute(
+      analysisSpecifications = analysisSpecifications,
+      modulesToExecute = executionSettings$modulesToExecute
     )
-    analysisSpecifications$moduleSpecifications <- analysisSpecifications$moduleSpecifications[moduleSubset]
   }
 
   if (is(executionSettings, "CdmExecutionSettings")) {
@@ -275,3 +232,54 @@ execute <- function(analysisSpecifications,
   error <- cli::combine_ansi_styles("red")
   cat(error(paste0("ERROR: ", message, "\n")))
 }
+
+.subsetAnalysisSpecificationByModulesToExecute <- function(analysisSpecification, modulesToExecute) {
+  # Get the modules in the analysis specification with their
+  # index in the array
+  modulesWithIndex <- lapply(
+    X = seq_along(analysisSpecifications$moduleSpecifications),
+    FUN = function(i) {
+      list(
+        idx = i,
+        module = analysisSpecifications$moduleSpecifications[[i]]$module
+      )
+    }
+  )
+  modulesInAnalysisSpecification <- sapply(
+    X = modulesWithIndex,
+    FUN = function(x) {
+      x$module
+    }
+  )
+
+  modulesToExecuteString <- paste(modulesToExecute, collapse = ", ")
+  modulesInAnalysisSpecificationString <- paste(modulesInAnalysisSpecification, collapse = ", ")
+
+  # Stop if we cannot find all of the requested modules
+  # to execute in the overall analysis specification
+  if (!all(tolower(modulesToExecute) %in% tolower(modulesInAnalysisSpecification))) {
+    errorMsg <- paste0(
+      "The executionSettings specified to run only the modules: ",
+      modulesToExecuteString,
+      ".\n However the analysis specification includes the following modules: ",
+      modulesInAnalysisSpecificationString
+    )
+    stop(errorMsg)
+  }
+
+  # Subset the analysis specifications to those modules
+  # specified by the user
+  cli::cli_alert_info(paste0("Runnning a subset of modules: ", modulesToExecuteString))
+  moduleSubset <- unlist(
+    lapply(
+      X = modulesWithIndex,
+      FUN = function(x) {
+        if (tolower(x$module) %in% tolower(modulesToExecute)) {
+          return(x$idx)
+        }
+      }
+    )
+  )
+  analysisSpecifications$moduleSpecifications <- analysisSpecifications$moduleSpecifications[moduleSubset]
+  return(analysisSpecifications)
+}
diff --git a/R/ResultDataModel.R b/R/ResultDataModel.R
@@ -41,6 +41,18 @@ createResultDataModel <- function(analysisSpecifications,
     resultsDataModelSettings = resultsDataModelSettings
   )
 
+  # Determine if the user has opted to subset to specific modules
+  # in the analysis specification. If so, validate that the
+  # modulesToExecute are present in the analysis specification
+  # before attempting to subset the analyses to run.
+  if (length(resultsDataModelSettings$modulesToExecute) > 0) {
+    analysisSpecifications <- .subsetAnalysisSpecificationByModulesToExecute(
+      analysisSpecifications = analysisSpecifications,
+      modulesToExecute = resultsDataModelSettings$modulesToExecute
+    )
+  }
+
+
   for (i in 1:length(analysisSpecifications$moduleSpecifications)) {
     moduleName <- analysisSpecifications$moduleSpecifications[[i]]$module
     moduleObj <- get(moduleName)$new()
@@ -77,6 +89,17 @@ uploadResults <- function(analysisSpecifications,
     resultsDataModelSettings = resultsDataModelSettings
   )
 
+  # Determine if the user has opted to subset to specific modules
+  # in the analysis specification. If so, validate that the
+  # modulesToExecute are present in the analysis specification
+  # before attempting to subset the analyses to run.
+  if (length(resultsDataModelSettings$modulesToExecute) > 0) {
+    analysisSpecifications <- .subsetAnalysisSpecificationByModulesToExecute(
+      analysisSpecifications = analysisSpecifications,
+      modulesToExecute = resultsDataModelSettings$modulesToExecute
+    )
+  }
+
   for (i in 1:length(analysisSpecifications$moduleSpecifications)) {
     moduleName <- analysisSpecifications$moduleSpecifications[[i]]$module
     moduleObj <- get(moduleName)$new()

diff --git a/R/Settings.R b/R/Settings.R
@@ -258,8 +258,7 @@ createEmptyAnalysisSpecificiations <- function() {
 #'                                   and attempt to pick up where they left off when this value is set to TRUE.
 #' @param maxCores                   The maximum number of processing cores to use for execution. The default is to
 #'                                   use all available cores on the machine.
-#' @param modulesToExecute           (Optional) A vector with the list of modules to execute. When an empty vector/NULL is supplied (default),
-#'                                   all modules in the analysis specification are executed.
+#' @template modulesToExecute
 #'
 #' @return
 #' An object of type `ExecutionSettings`.
@@ -312,8 +311,7 @@ createCdmExecutionSettings <- function(workDatabaseSchema,
 #'                                   in results.
 #' @param maxCores                   The maximum number of processing cores to use for execution. The default is to
 #'                                   use all available cores on the machine.
-#' @param modulesToExecute           (Optional) A vector with the list of modules to execute. When an empty vector/NULL is supplied (default),
-#'                                   all modules in the analysis specification are executed.
+#' @template modulesToExecute
 #'
 #' @return
 #' An object of type `ExecutionSettings`.
@@ -358,18 +356,21 @@ createResultsExecutionSettings <- function(resultsDatabaseSchema,
 #' @template resultsDatabaseSchema
 #' @template resultsFolder
 #' @param logFileName     Log location for data model operations
+#' @template modulesToExecute
 #'
 #' @return
 #' An object of type `ResultsDataModelSettings`
 #'
 #' @export
 createResultsDataModelSettings <- function(resultsDatabaseSchema,
                                            resultsFolder,
-                                           logFileName = file.path(resultsFolder, "strategus-results-data-model-log.txt")) {
+                                           logFileName = file.path(resultsFolder, "strategus-results-data-model-log.txt"),
+                                           modulesToExecute = c()) {
   errorMessages <- checkmate::makeAssertCollection()
   checkmate::assertCharacter(resultsDatabaseSchema, len = 1, add = errorMessages)
   checkmate::assertCharacter(resultsFolder, len = 1, add = errorMessages)
   checkmate::assertCharacter(logFileName, len = 1, add = errorMessages)
+  checkmate::assertVector(modulesToExecute, null.ok = TRUE, add = errorMessages)
   checkmate::reportAssertions(collection = errorMessages)
 
   # Normalize paths to convert relative paths to absolute paths

diff --git a/man-roxygen/modulesToExecute.R b/man-roxygen/modulesToExecute.R
@@ -0,0 +1,2 @@
+#' @param modulesToExecute           (Optional) A vector with the list of modules to execute. When an empty vector/NULL is supplied (default),
+#'                                   all modules in the analysis specification are executed.
diff --git a/man/createResultsDataModelSettings.Rd b/man/createResultsDataModelSettings.Rd
Original file line number	Diff line number	Diff line change
		@@ -0,0 +1,2 @@
		#' @param modulesToExecute (Optional) A vector with the list of modules to execute. When an empty vector/NULL is supplied (default),
		#' all modules in the analysis specification are executed.