From 8f69031eca6390d778bc3ecc465f0f76717f87ca Mon Sep 17 00:00:00 2001
From: Milan Malfait <38256462+milanmlft@users.noreply.github.com>
Date: Tue, 19 Nov 2024 19:26:34 +0100
Subject: [PATCH] WIP: try to work around the SQL error for
 `lubridate::quarter`

---
 preprocessing/R/monthly_counts.R              | 17 +++++++++++++-
 .../tests/testthat/test-monthly_counts.R      | 22 ++++++++++++++-----
 2 files changed, 33 insertions(+), 6 deletions(-)

diff --git a/preprocessing/R/monthly_counts.R b/preprocessing/R/monthly_counts.R
index 988e35d..2bf3a4d 100644
--- a/preprocessing/R/monthly_counts.R
+++ b/preprocessing/R/monthly_counts.R
@@ -99,7 +99,22 @@ summarise_counts <- function(omop_table, concept_col, date_col, level) {
 
   if (level == "quarterly") {
     # NOTE: lubridate::quarter is supported for postgres back-ends, but not sqlite
-    omop_table$date_quarter <- as.integer(lubridate::quarter(.data[[date_col]]))
+    tryCatch(
+      {
+        omop_table_with_quarter <- omop_table |>
+          dplyr::mutate(date_quarter = as.integer(lubridate::quarter(.data[[date_col]])))
+        dplyr::compute(omop_table_with_quarter) # Force execution of the query to check for the error
+      },
+      error = function(cnd) {
+        warning(
+          sprintf("Extracting quarter from `%s` failed with\n%s", date_col, cnd),
+          "\nCollecting table first and trying again.",
+          call. = FALSE
+        )
+        omop_table_with_quarter <- dplyr::collect(omop_table) |>
+          dplyr::mutate(date_quarter = as.integer(lubridate::quarter(.data[[date_col]])))
+      }
+    )
   }
 
   omop_table |>
diff --git a/preprocessing/tests/testthat/test-monthly_counts.R b/preprocessing/tests/testthat/test-monthly_counts.R
index e22e1c4..dbe0435 100644
--- a/preprocessing/tests/testthat/test-monthly_counts.R
+++ b/preprocessing/tests/testthat/test-monthly_counts.R
@@ -30,8 +30,8 @@ mock_measurement <- data.frame(
   value_as_concept_id = 0
 )
 
-test_that("calculate_monthly_counts produces the expected results", {
-  res <- calculate_monthly_counts(mock_measurement, measurement_concept_id, measurement_date)
+test_that("summarise_counts produces the expected results at monthly level", {
+  res <- summarise_counts(mock_measurement, "measurement_concept_id", "measurement_date", level = "monthly")
   expect_s3_class(res, "data.frame")
   expect_named(res, c("concept_id", "date_year", "date_month", "record_count", "person_count", "records_per_person"))
   expect_equal(nrow(res), 1)
@@ -41,9 +41,21 @@ test_that("calculate_monthly_counts produces the expected results", {
 
 db <- dbplyr::src_memdb()
 db_measurement <- dplyr::copy_to(db, mock_measurement, name = "measurement", overwrite = TRUE)
-test_that("calculate_monthly_counts works on Database-stored tables", {
-  ref <- calculate_monthly_counts(mock_measurement, measurement_concept_id, measurement_date)
-  db_res <- calculate_monthly_counts(db_measurement, measurement_concept_id, measurement_date)
+test_that("summarise_counts works on Database-stored tables at monthly level", {
+  ref <- summarise_counts(mock_measurement, "measurement_concept_id", "measurement_date", level = "monthly")
+  db_res <- summarise_counts(db_measurement, "measurement_concept_id", "measurement_date", level = "monthly")
+
+  expect_s3_class(db_res, "data.frame")
+  expect_named(db_res, c("concept_id", "date_year", "date_month", "record_count", "person_count", "records_per_person"))
+  expect_type(db_res$record_count, "integer")
+  expect_type(db_res$person_count, "integer")
+  expect_type(db_res$records_per_person, "double")
+  expect_identical(db_res, ref)
+})
+
+test_that("summarise_counts works on Database-stored tables at quarterly level", {
+  ref <- summarise_counts(mock_measurement, "measurement_concept_id", "measurement_date", level = "quarterly")
+  db_res <- summarise_counts(db_measurement, "measurement_concept_id", "measurement_date", level = "quarterly")
 
   expect_s3_class(db_res, "data.frame")
   expect_named(db_res, c("concept_id", "date_year", "date_month", "record_count", "person_count", "records_per_person"))