Refactor test files

DESCRIPTION

@@ -61,7 +61,7 @@ License: Apache License
 VignetteBuilder: knitr
 URL: https://ohdsi.github.io/CohortDiagnostics, https://github.com/OHDSI/CohortDiagnostics
 BugReports: https://github.com/OHDSI/CohortDiagnostics/issues
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.2
 Encoding: UTF-8
 Language: en-US
 StagedInstall: no

NAMESPACE

@@ -17,6 +17,7 @@ export(runCohortRelationshipDiagnostics)
 export(runCohortTimeSeriesDiagnostics)
 export(uploadResults)
 import(DatabaseConnector)
+importFrom(CohortGenerator,getCohortCounts)
 importFrom(CohortGenerator,getCohortTableNames)
 importFrom(FeatureExtraction,createDefaultCovariateSettings)
 importFrom(FeatureExtraction,createTemporalCovariateSettings)

R/CohortDiagnostics.R

@@ -26,3 +26,9 @@
 #' @importFrom methods is
 #' @importFrom FeatureExtraction createDefaultCovariateSettings createTemporalCovariateSettings
 NULL
+
+# re-export getCohortCounts from CohortGenerator
+
+#' @importFrom CohortGenerator getCohortCounts
+#' @export
+CohortGenerator::getCohortCounts

R/ConceptIds.R

@@ -14,24 +14,6 @@
 # See the License for the specific language governing permissions and
 # limitations under the License.
 
-createConceptTable <- function(connection, tempEmulationSchema) {
-  ParallelLogger::logTrace("Creating concept ID table for tracking concepts used in diagnostics")
-  sql <-
-    SqlRender::loadRenderTranslateSql(
-      "CreateConceptIdTable.sql",
-      packageName = utils::packageName(),
-      dbms = connection@dbms,
-      tempEmulationSchema = tempEmulationSchema,
-      table_name = "#concept_ids"
-    )
-  DatabaseConnector::executeSql(
-    connection = connection,
-    sql = sql,
-    progressBar = FALSE,
-    reportOverallTime = FALSE
-  )
-}
-
 exportConceptInformation <- function(connection = NULL,
                                      cdmDatabaseSchema,
                                      tempEmulationSchema,

R/ConceptSetUtils.R

@@ -14,6 +14,125 @@
 # See the License for the specific language governing permissions and
 # limitations under the License.
 
+#' Create the concept counts table used by CohortDiagnostics
+#' 
+#' CohortDiagnostics requires the record and person counts for all concepts in the CDM.
+#' createConceptCountsTable will create this table. To speed up execution pre-computed 
+#' Achilles data can be used in the creation of the table. This table can also be persisted 
+#' across executions of CohortDiagnostics and does not need to be recreated with each run.
+#'
+#' @template Connection 
+#' @template CdmDatabaseSchema 
+#' @template TempEmulationSchema 
+#' @param conceptCountsDatabaseSchema character. The schema where the concept counts table should be created.
+#' @param conceptCountsTable character. The name of concept counts table. If the name starts with # then a 
+#'                           temporary table will be created.
+#' @param achillesDatabaseSchema character. Schema where Achilles tables are stored in the database. 
+#'                               If provided and the correct analysis IDs exist
+#'                               then the Achilles results will be used to create the concept counts table.
+#' @param overwrite logical. Should the table be overwritten if it already exists? TRUE or FALSE (default)
+#'
+#' @return
+#' @export
+#'
+#' @examples
+#' \dontrun{
+#' connectionDetails <- Eunomia::getEunomiaConnectionDetails()
+#' connection <- DatabaseConnector::connect(connectionDetails)
+#' 
+#' createConceptCountsTable(connection = connection,
+#'                          cdmDatabaseSchema = "main",
+#'                          conceptCountsDatabaseSchema = "main",
+#'                          conceptCountsTable = "concept_counts",
+#'                          achillesDatabaseSchema = NULL,
+#'                          overwrite = FALSE)  
+#' 
+#' DatabaseConnector::disconnect(connection)
+#' }
+createConceptCountsTable <- function(connection = NULL,
+                                     cdmDatabaseSchema,
+                                     tempEmulationSchema = getOption("sqlRenderTempEmulationSchema"),
+                                     conceptCountsDatabaseSchema = NULL,
+                                     conceptCountsTable = "concept_counts",
+                                     achillesDatabaseSchema = NULL,
+                                     overwrite = FALSE) {browser()
+
+  dbRegex <- "^[a-zA-Z][a-zA-Z0-9_]*$" # regex for letters, numbers, and _ but must start with a letter
+  checkmate::assertClass(connection, "DatabaseConnectorConnection")
+  checkmate::assertCharacter(cdmDatabaseSchema, len = 1, min.chars = 1, any.missing = FALSE, pattern = dbRegex)
+  checkmate::assertCharacter(tempEmulationSchema, len = 1, min.chars = 1, any.missing = FALSE, pattern = dbRegex, null.ok = TRUE)
+  checkmate::assertCharacter(achillesDatabaseSchema, len = 1, min.chars = 1, any.missing = FALSE, pattern = dbRegex, null.ok = TRUE)
+  checkmate::assertLogical(overwrite, any.missing = FALSE, len = 1)
+  checkmate::assertCharacter(conceptCountsTable, len = 1, min.chars = 1, any.missing = FALSE)
+
+  # check if table exists, has expected column names, and at least a few rows
+
+  conceptCountsTableIsTemp <- (substr(conceptCountsTable, 1, 1) == "#")
+  if (conceptCountsTableIsTemp) {
+    checkmate::assertCharacter(conceptCountsDatabaseSchema, len = 1, min.chars = 1, any.missing = FALSE, pattern = dbRegex)
+  }
+
+  if (isFALSE(conceptCountsTableIsTemp) && isFALSE(overwrite)) {
+
+    tablesInSchema <- DatabaseConnector::getTableNames(connection, databaseSchema = conceptCountsDatabaseSchema, cast = "lower")
+
+    if (tolower(conceptCountsTable) %in% tablesInSchema) {
+      # check that the table has the correct column names and at least a few rows
+      result <- DatabaseConnector::renderTranslateQuerySql(
+        connection = connection,
+        sql = "select top 5 * from @schema.@concept_counts_table;",
+        tempEmulationSchema = tempEmulationSchema,
+        schema = conceptCountsDatabaseSchema,
+        concept_counts_table = conceptCountsTable
+      )
+
+      columnsExist <- all(c("concept_id", "concept_count", "concept_subjects") %in% tolower(colnames(result)))
+
+      if (columnsExist && (nrow(result) > 3)) {
+        ParallelLogger::logInfo("Concept counts table already exists and is not being overwritten")
+        return(invisible(NULL))
+      }
+    }
+  }
+
+  ParallelLogger::logInfo("Creating concept counts table")
+
+  useAchilles <- FALSE
+  if (!is.null(achillesDatabaseSchema)) {
+    # check that achilles tables exist
+    tablesInAchillesSchema <- DatabaseConnector::getTableNames(connection, databaseSchema = achillesDatabaseSchema, cast = "lower")
+    if ("achilles_results" %in% tablesInAchillesSchema) {
+      ParallelLogger::logInfo("Using achilles_results table to create the concept_counts table")
+      useAchilles <- TRUE
+    } else {
+      ParallelLogger::logInfo("achilles_results table was not found in the achilles schema")
+    }
+  }
+
+  sql <- SqlRender::readSql(system.file("sql", "sql_server", "CreateConceptCountTable.sql", package = "CohortDiagnostics"))
+  sql <- SqlRender::render(sql, 
+                           tempEmulationSchema = tempEmulationSchema,
+                           cdm_database_schema = cdmDatabaseSchema,
+                           work_database_schema = conceptCountsDatabaseSchema,
+                           concept_counts_table = conceptCountsTable,
+                           table_is_temp = conceptCountsTableIsTemp,
+                           use_achilles = useAchilles,
+                           achilles_database_schema = achillesDatabaseSchema)
+  sql <- SqlRender::translate(sql, DatabaseConnector::dbms(connection))
+  DatabaseConnector::executeSql(connection = connection, sql = sql)
+
+  n <- DatabaseConnector::renderTranslateQuerySql(
+    connection = connection,
+    sql = "select count(*) as n from @schema.@table;",
+    schema = conceptCountsDatabaseSchema,
+    table = conceptCountsTable
+  )
+
+  ParallelLogger::logInfo(paste("Concept counts table created with", n[[1]], "rows"))
+  if (n == 0) ParallelLogger::logWarn("concept_counts table has zeros rows!")
+  return(invisible(NULL))
+}
+
 .findOrphanConcepts <- function(connectionDetails = NULL,
                                 connection = NULL,
                                 cdmDatabaseSchema,
@@ -76,28 +195,4 @@
   return(orphanConcepts)
 }
 
-createConceptCountsTable <- function(connectionDetails = NULL,
-                                     connection = NULL,
-                                     cdmDatabaseSchema,
-                                     tempEmulationSchema = NULL,
-                                     conceptCountsDatabaseSchema = cdmDatabaseSchema,
-                                     conceptCountsTable = "concept_counts",
-                                     conceptCountsTableIsTemp = FALSE) {
-  ParallelLogger::logInfo("Creating internal concept counts table")
-  if (is.null(connection)) {
-    connection <- DatabaseConnector::connect(connectionDetails)
-    on.exit(DatabaseConnector::disconnect(connection))
-  }
-  sql <-
-    SqlRender::loadRenderTranslateSql(
-      "CreateConceptCountTable.sql",
-      packageName = utils::packageName(),
-      dbms = connection@dbms,
-      tempEmulationSchema = tempEmulationSchema,
-      cdm_database_schema = cdmDatabaseSchema,
-      work_database_schema = conceptCountsDatabaseSchema,
-      concept_counts_table = conceptCountsTable,
-      table_is_temp = conceptCountsTableIsTemp
-    )
-  DatabaseConnector::executeSql(connection, sql)
-}
+

R/ConceptSets.R

@@ -378,15 +378,17 @@ runConceptSetDiagnostics <- function(connection,
                                      runBreakdownIndexEvents,
                                      exportFolder,
                                      minCellCount,
-                                     conceptCountsDatabaseSchema = cdmDatabaseSchema,
+                                     conceptCountsDatabaseSchema = NULL,
                                      conceptCountsTable = "concept_counts",
                                      conceptCountsTableIsTemp = FALSE,
                                      cohortDatabaseSchema,
                                      cohortTable,
                                      useExternalConceptCountsTable = FALSE,
                                      incremental = FALSE,
                                      conceptIdTable = NULL,
-                                     recordKeepingFile) {
+                                     recordKeepingFile,
+                                     useAchilles,
+                                     resultsDatabaseSchema) {
   ParallelLogger::logInfo("Starting concept set diagnostics")
   startConceptSetDiagnostics <- Sys.time()
   subset <- dplyr::tibble()
@@ -476,7 +478,9 @@ runConceptSetDiagnostics <- function(connection,
           tempEmulationSchema = tempEmulationSchema,
           conceptCountsDatabaseSchema = conceptCountsDatabaseSchema,
           conceptCountsTable = conceptCountsTable,
-          conceptCountsTableIsTemp = conceptCountsTableIsTemp
+          conceptCountsTableIsTemp = conceptCountsTableIsTemp,
+          useAchilles = useAchilles,
+          resultsDatabaseSchema = resultsDatabaseSchema
         )
       }
     )
@@ -821,17 +825,8 @@ runConceptSetDiagnostics <- function(connection,
           split(subsetBreakdown, subsetBreakdown$cohortId),
           getCohortIndexEventBreakdown
         )
+
       data <- dplyr::bind_rows(data)
-      if (nrow(data) > 0) {
-        data <- data %>%
-          dplyr::mutate(databaseId = !!databaseId)
-        data <-
-          enforceMinCellValue(data, "conceptCount", minCellCount)
-        if ("subjectCount" %in% colnames(data)) {
-          data <-
-            enforceMinCellValue(data, "subjectCount", minCellCount)
-        }
-      }
 
       data <- makeDataExportable(
         x = data,