Use latest renv dependency, update/fix unit tests and GitHub Actions (#…

…83)
OHDSI · Sep 7, 2023 · ea27061 · ea27061
1 parent bc58d17
commit ea27061
Show file tree

Hide file tree

Showing 54 changed files with 2,732 additions and 851 deletions.
diff --git a/.github/workflows/R_CMD_check_Hades.yaml b/.github/workflows/R_CMD_check_Hades.yaml
@@ -20,9 +20,12 @@ jobs:
       fail-fast: false
       matrix:
         config:
-          - {os: windows-latest, r: 'release'}
-          - {os: macOS-latest, r: 'release'}
-          - {os: ubuntu-20.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
+          - {os: windows-latest, r: '4.2.3', rtools: '42', rspm: "https://cloud.r-project.org"}
+          - {os: macOS-latest, r: '4.2.3', rtools: '42', rspm: "https://cloud.r-project.org"}
+          - {os: ubuntu-20.04, r: '4.2.3', rtools: '42', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
+          - {os: windows-latest, r: 'release', rtools: '', rspm: "https://cloud.r-project.org"}
+          - {os: macOS-latest, r: 'release', rtools: '', rspm: "https://cloud.r-project.org"}
+          - {os: ubuntu-20.04, r: 'release', rtools: '', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
 
     env:
       GITHUB_PAT: ${{ secrets.GH_TOKEN }}
@@ -53,11 +56,12 @@ jobs:
       CDM5_SPARK_CONNECTION_STRING: ${{ secrets.CDM5_SPARK_CONNECTION_STRING }}
 
     steps:
-      - uses: actions/checkout@v2
+      - uses: actions/checkout@v3
 
       - uses: r-lib/actions/setup-r@v2
         with:
           r-version: ${{ matrix.config.r }}
+          rtools-version: ${{ matrix.config.rtools }}
 
       - uses: r-lib/actions/setup-tinytex@v2
 
@@ -66,7 +70,11 @@ jobs:
       - name: Install system requirements
         if: runner.os == 'Linux'
         run: |
-          sudo apt-get install -y libssh-dev
+          sudo apt-get install -y make
+          sudo apt-get install -y default-jdk
+          sudo apt-get install -y libcurl4-openssl-dev
+          sudo apt-get install -y libssl-dev
+          sudo apt-get install -y libglpk-dev
           while read -r cmd
           do
             eval sudo $cmd
@@ -84,20 +92,20 @@ jobs:
           check-dir: '"check"'
 
       - name: Upload source package
-        if: success() && runner.os == 'macOS' && github.event_name != 'pull_request' && github.ref == 'refs/heads/main'
+        if: success() && runner.os == 'Windows' && github.event_name != 'pull_request' && github.ref == 'refs/heads/main'
         uses: actions/upload-artifact@v2
         with:
           name: package_tarball
           path: check/*.tar.gz
 
       - name: Install covr
-        if: runner.os == 'macOS'
+        if: runner.os == 'Windows'
         run: |
           install.packages("covr")
         shell: Rscript {0}
 
       - name: Test coverage
-        if: runner.os == 'macOS'
+        if: runner.os == 'Windows'
         run: covr::codecov()
         shell: Rscript {0}
 

diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,8 +1,8 @@
 Package: Strategus
 Type: Package
 Title: Coordinating and Executing Analytics Using HADES Modules
-Version: 0.0.7
-Date: 2023-05-01
+Version: 0.1.0
+Date: 2023-08-15
 Authors@R: c(
 	person("Martijn", "Schuemie", email = "[email protected]", role = c("aut", "cre")),
 	person("Anthony", "Sena", email = "[email protected]", role = c("aut")),
@@ -15,12 +15,12 @@ License: Apache License 2.0
 URL: https://ohdsi.github.io/Strategus, https://github.com/OHDSI/Strategus
 BugReports: https://github.com/OHDSI/Strategus/issues
 Depends:
-	R (>= 4.0.0),
-	CohortGenerator (>= 0.7.0),
-	DatabaseConnector (>= 5.1.0)
+	R (>= 4.2.0),
+	CohortGenerator (>= 0.8.0),
+	DatabaseConnector (>= 6.2.3)
 Imports:
   targets,
-  renv (>= 0.15.5),
+  renv (>= 1.0.0),
   ParallelLogger (>= 3.1.0),
   dplyr,
   checkmate,

diff --git a/R/DatabaseMetaData.R b/R/DatabaseMetaData.R
@@ -44,6 +44,10 @@ createDatabaseMetaData <- function(executionSettings, keyringName = NULL) {
   )
   cdmTableList <- unique(tolower(cdmTableList))
 
+  if (length(cdmTableList) == 0) {
+    stop(sprintf("FATAL ERROR: No tables found in your OMOP CDM. Please confirm you are using the proper connection information, in particular the CDM schema name."))
+  }
+
   if (!length(cdmTableList[which(x = cdmTableList %in% requiredTables)]) == length(requiredTables)) {
     missingCdmTables <- requiredTables[!(requiredTables %in% cdmTableList)]
     stop(sprintf("FATAL ERROR: Your OMOP CDM is missing the following required tables: %s", paste(missingCdmTables, collapse = ", ")))

diff --git a/R/Execution.R b/R/Execution.R
@@ -24,18 +24,13 @@
 #' Execute analysis specifications.
 #'
 #' @template AnalysisSpecifications
-#' @param executionSettings       An object of type `ExecutionSettings` as created
-#'                                by [createCdmExecutionSettings()] or [createResultsExecutionSettings()].
+#' @template executionSettings
 #' @param executionScriptFolder   Optional: the path to use for storing the execution script.
 #'                                when NULL, this function will use a temporary
 #'                                file location to create the script to execute.
-#'
 #' @template keyringName
-#'
 #' @param restart                 Restart run? Requires `executionScriptFolder` to be specified, and be
 #'                                the same as the `executionScriptFolder` used in the run to restart.
-#'
-#'
 #' @return
 #' Does not return anything. Is called for the side-effect of executing the specified
 #' analyses.
@@ -62,7 +57,7 @@ execute <- function(analysisSpecifications,
     )
     DatabaseConnector::assertTempEmulationSchemaSet(
       dbms = connectionDetails$dbms,
-      tempEmulationSchema = getOption("sqlRenderTempEmulationSchema")
+      tempEmulationSchema = executionSettings$tempEmulationSchema
     )
   }
   modules <- ensureAllModulesInstantiated(analysisSpecifications)
@@ -115,13 +110,12 @@ generateTargetsScript <- function(analysisSpecifications, executionSettings, dep
     moduleToTargetNames <- readRDS(moduleToTargetNamesFileName)
     dependencies <- readRDS(dependenciesFileName)
 
-    library(dplyr)
-    tar_option_set(packages = c('Strategus', 'keyring'), imports = c('Strategus', 'keyring'))
+    targets::tar_option_set(packages = c("Strategus", "keyring"), imports = c("Strategus", "keyring"))
     targetList <- list(
-      tar_target(analysisSpecifications, readRDS(analysisSpecificationsFileName)),
+      targets::tar_target(analysisSpecifications, readRDS(analysisSpecificationsFileName)),
       # NOTE Execution settings could be mapped to many different cdms making re-execution across cdms much simpler
-      tar_target(executionSettings, readRDS(executionSettingsFileName)),
-      tar_target(keyringSettings, readRDS(keyringSettingsFileName))
+      targets::tar_target(executionSettings, readRDS(executionSettingsFileName)),
+      targets::tar_target(keyringSettings, readRDS(keyringSettingsFileName))
     )
 
     # factory for producing module targets based on their dependencies
@@ -132,30 +126,28 @@ generateTargetsScript <- function(analysisSpecifications, executionSettings, dep
     for (i in 1:length(analysisSpecificationsLoad$moduleSpecifications)) {
       moduleSpecification <- analysisSpecificationsLoad$moduleSpecifications[[i]]
       targetName <- sprintf("%s_%d", moduleSpecification$module, i)
-      dependencyModules <- dependencies %>%
-        filter(.data$module == moduleSpecification$module) %>%
-        pull(.data$dependsOn)
-
-      dependencyTargetNames <- moduleToTargetNames %>%
-        filter(.data$module %in% dependencyModules) %>%
-        pull(.data$targetName)
-
-      # Use of tar_target_raw allows dynamic names
-      targetList[[length(targetList) + 1]] <- tar_target_raw(targetName,
-                                                             substitute(Strategus:::runModule(analysisSpecifications, keyringSettings, i, executionSettings),
-                                                                        env = list(i = i)),
-                                                             deps = c("analysisSpecifications", "keyringSettings", "executionSettings", dependencyTargetNames))
-
-      if (execResultsUpload) {
-        resultsTargetName <- paste0(targetName, "_results_upload")
-        targetList[[length(targetList) + 1]] <- tar_target_raw(resultsTargetName,
-                                                               substitute(Strategus:::runResultsUpload(analysisSpecifications, keyringSettings, i, executionSettings),
-                                                                          env = list(i = i)),
-                                                               deps = c("analysisSpecifications", "keyringSettings", "executionSettings", targetName))
+      dependencyModules <- dependencies[dependencies$module == moduleSpecification$module,]$dependsOn
+      dependencyTargetNames <- moduleToTargetNames[moduleToTargetNames$module %in% dependencyModules,]$targetName
+
+        # Use of tar_target_raw allows dynamic names
+        targetList[[length(targetList) + 1]] <- targets::tar_target_raw(targetName,
+          substitute(Strategus:::runModule(analysisSpecifications, keyringSettings, i, executionSettings),
+            env = list(i = i)
+          ),
+          deps = c("analysisSpecifications", "keyringSettings", "executionSettings", dependencyTargetNames)
+        )
+
+        if (execResultsUpload) {
+          resultsTargetName <- paste0(targetName, "_results_upload")
+          targetList[[length(targetList) + 1]] <- targets::tar_target_raw(resultsTargetName,
+            substitute(Strategus:::runResultsUpload(analysisSpecifications, keyringSettings, i, executionSettings),
+              env = list(i = i)
+            ),
+            deps = c("analysisSpecifications", "keyringSettings", "executionSettings", targetName)
+          )
+        }
       }
-    }
-
-    targetList
+      targetList
   }, script = fileName)
 
   #Store settings objects in the temp folder so they are available in targets

diff --git a/R/ModuleEnv.R b/R/ModuleEnv.R
@@ -44,9 +44,11 @@
 #'
 #' @param code              code block to execute
 #' @param moduleFolder      Instantiated Strategus module folder
-#' @param injectVars         list of var names list(name=value) to replace (e.g. replace list(foo = "some string") will
+#' @param injectVars        list of var names list(name=value) to replace (e.g. replace list(foo = "some string") will
 #'                          find the pattern foo and replace it with the string some string - be careful!
-#' @param tempScriptFile    tempFile to write script to (ret
+#' @param tempScriptFile    tempFile to write script to
+#' @param useLocalStrategusLibrary Use the locally installed Strategus library? TRUE will use the Strategus
+#'                          installation from the calling R process.
 #' @param job               run as rstudio job
 #' @param processName       String name for process
 #' @returns NULL invisibly
@@ -67,22 +69,14 @@ withModuleRenv <- function(code,
 
   # Enforce attachment of Strategus from calling process - note one inside the renv
   if (useLocalStrategusLibrary) {
-    libPath <- file.path(find.package("Strategus"), "../")
-    script <- c(sprintf("library(Strategus, lib.loc = '%s')", libPath),
-                script)
+    script <- c(.getLocalLibraryScipt("Strategus"), script)
     # Adding Strategus dependencies to the script
-    libPath <- file.path(find.package("CohortGenerator"), "../")
-    script <- c(sprintf("library(CohortGenerator, lib.loc = '%s')", libPath),
-                script)
-    libPath <- file.path(find.package("DatabaseConnector"), "../")
-    script <- c(sprintf("library(DatabaseConnector, lib.loc = '%s')", libPath),
-                script)
-    libPath <- file.path(find.package("keyring"), "../")
-    script <- c(sprintf("library(keyring, lib.loc = '%s')", libPath),
-                script)
-    libPath <- file.path(find.package("openssl"), "../")
-    script <- c(sprintf("library(openssl, lib.loc = '%s')", libPath),
-                script)
+    c(.getLocalLibraryScipt("R6"), script)
+    c(.getLocalLibraryScipt("CohortGenerator"), script)
+    c(.getLocalLibraryScipt("DatabaseConnector"), script)
+    c(.getLocalLibraryScipt("keyring"), script)
+    c(.getLocalLibraryScipt("openssl"), script)
+    c(.getLocalLibraryScipt("dplyr"), script)
   }
 
   # Write file and execute script inside an renv
@@ -97,3 +91,8 @@ withModuleRenv <- function(code,
   )
   return(invisible(NULL))
 }
+
+.getLocalLibraryScipt <- function(x) {
+  libPath <- file.path(find.package(x), "../")
+  sprintf("library(%s, lib.loc = '%s')", x, libPath)
+}
diff --git a/R/ModuleInstantiation.R b/R/ModuleInstantiation.R
@@ -38,9 +38,9 @@ ensureAllModulesInstantiated <- function(analysisSpecifications) {
 
   # Verify only one version per module:
   multipleVersionsPerModule <- modules %>%
-    group_by(.data$module) %>%
+    group_by(module) %>%
     summarise(versions = n()) %>%
-    filter(.data$versions > 1)
+    filter(versions > 1)
   if (nrow(multipleVersionsPerModule) > 0) {
     stop(sprintf(
       "Only one version per module allowed in a single analyses specification.\nMultiple versions found for module(s) `%s`.",
@@ -61,7 +61,7 @@ ensureAllModulesInstantiated <- function(analysisSpecifications) {
   # Check required dependencies have been installed:
   dependencies <- extractDependencies(modules)
   missingDependencies <- dependencies %>%
-    filter(!.data$dependsOn %in% modules$module)
+    filter(!dependsOn %in% modules$module)
   if (nrow(missingDependencies) > 0) {
     message <- paste(
       c(
@@ -91,7 +91,7 @@ getModuleTable <- function(analysisSpecifications, distinct = FALSE) {
     bind_rows()
   if (distinct) {
     modules <- modules %>%
-      distinct(.data$module, .data$version, .keep_all = TRUE)
+      distinct(module, version, .keep_all = TRUE)
   }
   return(modules)
 }
@@ -144,33 +144,33 @@ instantiateModule <- function(module, version, remoteRepo, remoteUsername, modul
   dir.create(moduleFolder)
   success <- FALSE
   on.exit(if (!success) unlink(moduleFolder, recursive = TRUE))
+  moduleFile <- file.path(moduleFolder, sprintf("%s_%s.zip", module, version))
   if (module == "TestModule1") {
-    # For demo purposes only: get module from extras folder
-    files <- list.files("extras/TestModules/TestModule1", full.names = TRUE, include.dirs = TRUE, all.files = TRUE)
-    files <- files[!grepl("renv$", files)]
-    files <- files[!grepl("\\.$", files)]
-    files <- files[!grepl(".Rhistory$", files)]
-    file.copy(files, moduleFolder, recursive = TRUE)
-    dir.create(file.path(moduleFolder, "renv"))
-    file.copy("extras/TestModules/TestModule1/renv/activate.R", file.path(moduleFolder, "renv"), recursive = TRUE)
+    # For unit testing purposes only: get module from inst/testdata folder
+    file.copy(
+      from = system.file(
+        file.path("testdata", basename(moduleFile)),
+        package = utils::packageName()
+      ),
+      to = moduleFolder
+    )
   } else {
-    moduleFile <- file.path(moduleFolder, sprintf("%s_%s.zip", module, version))
     moduleUrl <- sprintf("https://%s/%s/%s/archive/refs/tags/v%s.zip", remoteRepo, remoteUsername, module, version)
     utils::download.file(url = moduleUrl, destfile = moduleFile)
-    utils::unzip(zipfile = moduleFile, exdir = moduleFolder)
-    unlink(moduleFile)
-    # At this point, the unzipped folders will likely exist in a sub folder.
-    # Move all files from that sub folder to the main module folder
-    subFolders <- list.dirs(path = moduleFolder, recursive = FALSE)
-    if (length(subFolders) > 0) {
-      for (i in 1:length(subFolders)) {
-        R.utils::copyDirectory(
-          from = subFolders[i],
-          to = moduleFolder,
-          recursive = TRUE
-        )
-        unlink(subFolders[i], recursive = TRUE)
-      }
+  }
+  utils::unzip(zipfile = moduleFile, exdir = moduleFolder)
+  unlink(moduleFile)
+  # At this point, the unzipped folders will likely exist in a sub folder.
+  # Move all files from that sub folder to the main module folder
+  subFolders <- list.dirs(path = moduleFolder, recursive = FALSE)
+  if (length(subFolders) > 0) {
+    for (i in 1:length(subFolders)) {
+      R.utils::copyDirectory(
+        from = subFolders[i],
+        to = moduleFolder,
+        recursive = TRUE
+      )
+      unlink(subFolders[i], recursive = TRUE)
     }
   }
 
@@ -223,10 +223,10 @@ getModuleRenvDependencies <- function(moduleFolder) {
   )
 
   missingFiles <- tibble::enframe(renvRequiredFiles) %>%
-    dplyr::mutate(fileExists = file.exists(file.path(moduleFolder, .data$value))) %>%
-    dplyr::rename(fileName = .data$value) %>%
+    dplyr::mutate(fileExists = file.exists(file.path(moduleFolder, value))) %>%
+    dplyr::rename(fileName = value) %>%
     dplyr::select("fileName", "fileExists") %>%
-    dplyr::filter(.data$fileExists == FALSE)
+    dplyr::filter(fileExists == FALSE)
 
   invisible(missingFiles)
 }