createCohorts & duckdb

.github/workflows/R_CMD_check_Hades.yaml

@@ -102,7 +102,7 @@ jobs:
 
       - name: Upload source package
         if: success() && runner.os == 'macOS' && github.event_name != 'pull_request' && github.ref == 'refs/heads/main'
-        uses: actions/upload-artifact@v2
+        uses: actions/upload-artifact@v4
         with:
           name: package_tarball
           path: check/*.tar.gz
@@ -172,7 +172,7 @@ jobs:
 
       - name: Download package tarball
         if: ${{ env.new_version != '' }}
-        uses: actions/download-artifact@v2
+        uses: actions/download-artifact@4.1.7
         with:
           name: package_tarball
 

R/Cohorts.R

@@ -38,31 +38,41 @@ createCohorts <- function(connectionDetails,
     stop("connectionDetails is not valid.")
   }
 
-  if (connectionDetails$dbms != "sqlite") {
-    stop("createCohorts only supports sqlite")
+  if (connectionDetails$dbms != "sqlite" && connectionDetails$dbms != "duckdb") {
+    stop("createCohorts only supports sqlite and duckdb")
   }
 
   if (cdmDatabaseSchema != "main" || cohortDatabaseSchema != "main") {
-    stop("sqlite only supports the main schema")
+    stop("only main schema is supported")
   }
 
   if (cohortTable != "cohort") {
     warning("The cohortTable argument to createCohorts was deprecated in Eunomia v2.1.0")
   }
 
-  connection <- DBI::dbConnect(RSQLite::SQLite(), connectionDetails$server())
-  on.exit(DBI::dbDisconnect(connection))
+  if (connectionDetails$dbms == "sqlite") {
+    connection <- DBI::dbConnect(RSQLite::SQLite(), connectionDetails$server())
+    on.exit(DBI::dbDisconnect(connection))
 
-  # Create example cohort table
-  pathToSql <- system.file("sql", "CreateCohortTable.sql",package = "Eunomia", mustWork = TRUE)
-  sql <- readChar(pathToSql, file.info(pathToSql)$size)
-  sql <- gsub("--[a-zA-Z0-9 ]*", "", sql) # remove comments in sql
-  sql <- strsplit(gsub("\n", " ", sql), ";")[[1]] # remove newlines, split on semicolon
-  sql <- trimws(sql) # trim white space
-  sql <- sql[-which(sql == "")] # remove empty lines
+    # Create example cohort table
+    pathToSql <- system.file("sql", "CreateCohortTable.sql",package = "Eunomia", mustWork = TRUE)
+    sql <- readChar(pathToSql, file.info(pathToSql)$size)
+    sql <- gsub("--[a-zA-Z0-9 ]*", "", sql) # remove comments in sql
+    sql <- strsplit(gsub("\n", " ", sql), ";")[[1]] # remove newlines, split on semicolon
+    sql <- trimws(sql) # trim white space
+    sql <- sql[-which(sql == "")] # remove empty lines
 
-  for (i in seq_along(sql)) {
-    DBI::dbExecute(connection, sql[i])
+    for (i in seq_along(sql)) {
+      DBI::dbExecute(connection, sql[i])
+    }
+  }
+  else {
+    connection <- DatabaseConnector::connect(connectionDetails)
+    on.exit(DatabaseConnector::dbDisconnect(connection))
+
+    # Create example cohort table
+    cohortData <- readRDS(system.file("cohorts.rds", package = "Eunomia", mustWork = T))
+    DatabaseConnector::dbWriteTable(conn = connection, name = cohortTable, value = cohortData, overwrite = TRUE)
   }
 
   # Fetch cohort counts:

tests/testthat/test-basic.R

@@ -50,7 +50,7 @@ test_that("Query", {
   DatabaseConnector::disconnect(connection)
 })
 
-test_that("Cohort construction", {
+test_that("Cohort construction - sqlite", {
   connectionDetails <- getEunomiaConnectionDetails()
   x <- createCohorts(connectionDetails)
   connection <- DatabaseConnector::connect(connectionDetails)
@@ -71,6 +71,27 @@ test_that("Cohort construction", {
   expect_false(DatabaseConnector::dbIsValid(connection))
 })
 
+test_that("Cohort construction - duckdb", {
+  connectionDetails <- getEunomiaConnectionDetails(dbms = "duckdb")
+  x <- createCohorts(connectionDetails)
+  connection <- DatabaseConnector::connect(connectionDetails)
+
+  sql <- "SELECT COUNT(*)
+          FROM main.cohort
+          WHERE cohort_definition_id = 1;"
+  cohortCount <- DatabaseConnector::renderTranslateQuerySql(connection, sql)
+  expect_gt(cohortCount, 0)
+
+  cohort <- DatabaseConnector::dbGetQuery(connection, "SELECT * FROM main.cohort;")
+  expect_false(any(is.na(cohort$cohort_definition_id)))
+  expect_false(any(is.na(cohort$subject_id)))
+  expect_false(any(is.na(cohort$cohort_start_date)))
+  expect_false(any(is.na(cohort$cohort_end_date)))
+
+  DatabaseConnector::disconnect(connection)
+  expect_false(DatabaseConnector::dbIsValid(connection))
+})
+
 test_that("deprecated arguments in createCohorts", {
   connectionDetails <- getEunomiaConnectionDetails()
   expect_error(createCohorts(connectionDetails, cdmDatabaseSchema = "blah"))