Refactor Strategus module approach (#145)

* Implementation of CohortIncidence module. (#147) * Adjustments from testing --------- Co-authored-by: Chris Knoll <[email protected]>
OHDSI · Jul 31, 2024 · 0a0171b · 0a0171b
1 parent 33dd01b
commit 0a0171b
Show file tree

Hide file tree

Showing 147 changed files with 7,767 additions and 12,654 deletions.
diff --git a/.github/workflows/R_CMD_check_Hades.yaml b/.github/workflows/R_CMD_check_Hades.yaml
@@ -20,9 +20,6 @@ jobs:
       fail-fast: false
       matrix:
         config:
-          - {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"}
@@ -61,7 +58,6 @@ jobs:
       - 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
 
@@ -70,11 +66,7 @@ jobs:
       - name: Install system requirements
         if: runner.os == 'Linux'
         run: |
-          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
+          sudo apt-get install -y libssh-dev
           while read -r cmd
           do
             eval sudo $cmd

diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,8 +1,8 @@
 Package: Strategus
 Type: Package
 Title: Coordinating and Executing Analytics Using HADES Modules
-Version: 0.3.0
-Date: 2023-06-04
+Version: 1.0.0
+Date: 2024-07-10
 Authors@R: c(
 	person("Martijn", "Schuemie", email = "[email protected]", role = c("aut")),
 	person("Anthony", "Sena", email = "[email protected]", role = c("aut", "cre")),
@@ -17,36 +17,44 @@ BugReports: https://github.com/OHDSI/Strategus/issues
 Depends:
 	R (>= 4.2.0),
 	CohortGenerator (>= 0.8.0),
-	DatabaseConnector (>= 6.2.3)
+	DatabaseConnector (>= 6.2.3),
+  R6
 Imports:
-  targets,
-  renv (>= 1.0.0),
   ParallelLogger (>= 3.1.0),
   dplyr,
   checkmate,
-  keyring,
   rlang,
-  utils,
-  R.utils,
   digest,
   methods,
-  tibble,
-  ResultModelManager (>= 0.3.0),
-  SqlRender (>= 1.11.0),
-  semver,
-  httr2,
-  jsonlite
+  ResultModelManager (>= 0.5.8),
+  SqlRender (>= 1.18.0)
 Suggests:
-  testthat (>= 3.0.0),
+  Characterization,
+  CirceR,
+  CohortDiagnostics,
+  CohortIncidence,
+  CohortMethod,
+  Cyclops,
+  Eunomia,
+  EvidenceSynthesis,
+  FeatureExtraction,
   fs,
   knitr,
+  PatientLevelPrediction,
   rmarkdown,
-  Eunomia,
+  RSQLite,
+  SelfControlledCaseSeries,
+  testthat (>= 3.0.0),
   withr
 Remotes:
+  ohdsi/Characterization,
+  ohdsi/CohortDiagnostics,
   ohdsi/CohortGenerator,
+  ohdsi/CohortIncidence,
+  ohdsi/CohortMethod,
+  ohdsi/PatientLevelPrediction,
   ohdsi/ResultModelManager,
-  ohdsi/Eunomia
+  ohdsi/SelfControlledCaseSeries
 VignetteBuilder: knitr
 NeedsCompilation: no
 RoxygenNote: 7.3.1

diff --git a/NAMESPACE b/NAMESPACE
@@ -1,25 +1,36 @@
 # Generated by roxygen2: do not edit by hand
 
+export(CharacterizationModule)
+export(CohortDiagnosticsModule)
+export(CohortGeneratorModule)
+export(CohortIncidenceModule)
+export(CohortMethodModule)
+export(EvidenceSynthesisModule)
+export(PatientLevelPredictionModule)
+export(SelfControlledCaseSeriesModule)
+export(StrategusModule)
+export(addCharacterizationModuleSpecifications)
+export(addCohortDiagnosticsModuleSpecifications)
+export(addCohortGeneratorModuleSpecifications)
+export(addCohortIncidenceModuleSpecifications)
+export(addCohortMethodeModuleSpecifications)
+export(addEvidenceSynthesisModuleSpecifications)
 export(addModuleSpecifications)
+export(addPatientLevelPredictionModuleSpecifications)
+export(addSelfControlledCaseSeriesModuleSpecifications)
 export(addSharedResources)
-export(compareLockFiles)
 export(createCdmExecutionSettings)
 export(createEmptyAnalysisSpecificiations)
-export(createResultDataModels)
+export(createResultDataModel)
+export(createResultsDataModelSettings)
 export(createResultsExecutionSettings)
-export(ensureAllModulesInstantiated)
 export(execute)
-export(getModuleList)
-export(installLatestModule)
-export(retrieveConnectionDetails)
-export(storeConnectionDetails)
-export(syncLockFile)
-export(unlockKeyring)
-export(validateLockFile)
-export(verifyModuleInstallation)
+export(getDatabaseIdentifierFilePath)
+export(uploadResults)
 export(zipResults)
 import(CohortGenerator)
 import(DatabaseConnector)
+import(R6)
 import(dplyr)
 importFrom(methods,is)
 importFrom(rlang,.data)
diff --git a/R/DatabaseMetaData.R b/R/DatabaseMetaData.R
@@ -21,16 +21,27 @@
 # carefully consider serialization and deserialization to JSON, which currently
 # uses custom functionality in ParallelLogger to maintain object attributes.
 
-createDatabaseMetaData <- function(executionSettings, keyringName = NULL) {
-  databaseMetaDataFolder <- file.path(executionSettings$resultsFolder, "DatabaseMetaData")
+#' Provides the file path to the database identifier file created
+#' by Strategus
+#'
+#' @description
+#' This function is used to identify the location of the database identifier
+#' created by Strategus when running an analysis specification. This
+#' location is important when uploading results since the database identifier
+#' may be needed to purge old results for a given database identifier.
+#'
+#' @template resultsFolder
+#' @export
+getDatabaseIdentifierFilePath <- function(resultsFolder) {
+  return(file.path(.getDatabaseMetaDataResultsFolder(resultsFolder), "database_meta_data.csv"))
+}
+
+.createDatabaseMetaData <- function(executionSettings, connectionDetails) {
+  databaseMetaDataFolder <- .getDatabaseMetaDataResultsFolder(executionSettings$resultsFolder)
   if (!dir.exists(databaseMetaDataFolder)) {
     dir.create(databaseMetaDataFolder, recursive = TRUE)
   }
 
-  connectionDetails <- retrieveConnectionDetails(
-    connectionDetailsReference = executionSettings$connectionDetailsReference,
-    keyringName = keyringName
-  )
   connection <- DatabaseConnector::connect(connectionDetails)
   on.exit(DatabaseConnector::disconnect(connection))
 
@@ -54,7 +65,10 @@ createDatabaseMetaData <- function(executionSettings, keyringName = NULL) {
   }
 
   resultsDataModel <- CohortGenerator::readCsv(
-    file = system.file("databaseMetaDataRdms.csv", package = "Strategus"),
+    file = system.file(
+      file.path("csv", "databaseMetaDataRdms.csv"),
+      package = "Strategus"
+    ),
     warnOnCaseMismatch = FALSE
   )
 
@@ -132,3 +146,53 @@ createDatabaseMetaData <- function(executionSettings, keyringName = NULL) {
   )
   return(databaseId)
 }
+
+.createDatabaseMetadataResultsDataModel <- function(resultsConnectionDetails,
+                                                    resultsDataModelSettings) {
+  rdmsFile <- file.path(.getDatabaseMetaDataResultsFolder(resultsDataModelSettings$resultsFolder), "resultsDataModelSpecification.csv")
+  if (file.exists(rdmsFile)) {
+    rlang::inform("Creating results data model for database metadata")
+    connection <- DatabaseConnector::connect(resultsConnectionDetails)
+    on.exit(DatabaseConnector::disconnect(connection))
+
+    # Create the SQL from the resultsDataModelSpecification.csv
+    sql <- ResultModelManager::generateSqlSchema(
+      csvFilepath = rdmsFile
+    )
+    sql <- SqlRender::render(
+      sql = sql,
+      database_schema = resultsDataModelSettings$resultsDatabaseSchema
+    )
+    DatabaseConnector::executeSql(connection = connection, sql = sql)
+  } else {
+    warning("DatabaseMetaData not found - skipping table creation")
+  }
+}
+
+.uploadDatabaseMetadata <- function(resultsConnectionDetails,
+                                    resultsDataModelSettings) {
+  databaseMetaDataResultsFolder <- .getDatabaseMetaDataResultsFolder(resultsDataModelSettings$resultsFolder)
+  rdmsFile <- file.path(.getDatabaseMetaDataResultsFolder(resultsDataModelSettings$resultsFolder), "resultsDataModelSpecification.csv")
+  if (file.exists(rdmsFile)) {
+    rlang::inform("Uploading database metadata")
+    connection <- DatabaseConnector::connect(resultsConnectionDetails)
+    on.exit(DatabaseConnector::disconnect(connection))
+
+    specification <- CohortGenerator::readCsv(file = rdmsFile)
+    ResultModelManager::uploadResults(
+      connection = connection,
+      schema = resultsDataModelSettings$resultsDatabaseSchema,
+      resultsFolder = databaseMetaDataResultsFolder,
+      purgeSiteDataBeforeUploading = TRUE,
+      databaseIdentifierFile = getDatabaseIdentifierFilePath(resultsDataModelSettings$resultsFolder),
+      specifications = specification
+    )
+  } else {
+    warning("DatabaseMetaData not found - skipping table creation")
+  }
+}
+
+.getDatabaseMetaDataResultsFolder <- function(resultsFolder) {
+  return(file.path(resultsFolder, "DatabaseMetaData"))
+}
+