Merge pull request #214 from CDU-data-science-team/update_trust

Update NUH setup
The-Strategy-Unit · Nov 28, 2023 · d29399d · d29399d
2 parents 3c7f7cf + a2413ea
commit d29399d
Show file tree

Hide file tree

Showing 6 changed files with 53 additions and 17 deletions.
diff --git a/R/tidy_upload.R b/R/tidy_upload.R
@@ -1,17 +1,19 @@
 # function to do trust specific data cleaning
-tidy_trust_gosh <- function(db_tidy) {
+tidy_trust_nuh <- function(db_tidy) {
   db_tidy %>%
     dplyr::mutate(age = as.integer(age)) %>%
     dplyr::mutate(
       age = dplyr::case_when(
-        age < 12 ~ "0 - 11",
-        age < 18 ~ "12 - 17",
-        age < 26 ~ "18 - 25",
-        age < 40 ~ "26 - 39",
-        age < 65 ~ "40 - 64",
-        age < 80 ~ "65 - 79",
-        age > 79 ~ "80+",
-        TRUE ~ as.character(age)
+        age < 8 ~ "0 - 7",
+        age < 12 ~ "8 - 11",
+        age < 16 ~ "12 - 15",
+        age < 26 ~ "16 - 25",
+        age < 36 ~ "26 - 35",
+        age < 46 ~ "36 - 45",
+        age < 56 ~ "46 - 55",
+        age < 66 ~ "56 - 65",
+        age > 65 ~ "Over 65",
+        TRUE ~ NA_character_
       )
     )
 }
@@ -150,7 +152,7 @@ upload_data <- function(data, conn, trust_id, user, write_db = TRUE) {
     ) 
 
   # do trust specific data cleaning ----
-  if (trust_id == "trust_GOSH") db_tidy <- db_tidy %>% tidy_trust_gosh()
+  if (trust_id == "trust_NUH") db_tidy <- db_tidy %>% tidy_trust_nuh()
   if (trust_id == "trust_NEAS") db_tidy <- db_tidy %>% tidy_trust_neas()
   if (trust_id == "trust_NTH") db_tidy <- db_tidy %>% tidy_trust_nth()
 

diff --git a/dev/02_dev.R b/dev/02_dev.R
@@ -128,6 +128,7 @@ usethis::use_test("general_helpers")
 usethis::use_test("mod_data_management_fct_helper")
 usethis::use_test("app_server")
 usethis::use_test("app_ui")
+usethis::use_test("table_schemas")
 
 # Documentation
 

diff --git a/inst/golem-config.yml b/inst/golem-config.yml
@@ -99,13 +99,15 @@ phase_2_demo:
   demography_3: ethnicity
 trust_NUH:
   trust_name: trust_NUH
-  comment_1: Why give this answer and What could be improved?
+  comment_1: Why did you answer this way?
+  comment_2: What could be improved?
   question_1: fft
   location_1: Division
   location_2: Specialty
   location_3: Ward
   demography_1: gender
   demography_2: ethnicity
+  demography_3: age
   extra_variable_1: Rating channels
   extra_variable_2: Date feedback given
   extra_variable_3: Exclude from reports

diff --git a/tests/testthat/test-app_config.R b/tests/testthat/test-app_config.R
@@ -24,9 +24,10 @@ test_that("trust configuration is still the same", {
   expect_true(isTruthy(get_golem_config("location_2")))
   expect_true(isTruthy(get_golem_config("location_3")))
   expect_true(isTruthy(get_golem_config("comment_1")))
-  expect_false(isTruthy(get_golem_config("comment_2")))
+  expect_true(isTruthy(get_golem_config("comment_2")))
   expect_equal(get_golem_config("demography_1"), "gender")
   expect_equal(get_golem_config("demography_2"), "ethnicity")
+  expect_equal(get_golem_config("demography_3"), "age")
 
   # trust_GOSH ----
   withr::local_envvar("R_CONFIG_ACTIVE" = "trust_GOSH")

diff --git a/tests/testthat/test-table_schemas.R b/tests/testthat/test-table_schemas.R
@@ -0,0 +1,30 @@
+test_that("Validate all trusts' table schema", {
+  skip_on_ci()
+
+  # Create  DB connection pool
+  pool <- get_pool()
+
+  onStop(function() {
+    pool::poolClose(pool)
+  })
+
+  principal_table <- "phase_2_demo"
+
+  # NUH
+  expect_identical(
+    DBI::dbGetQuery(pool, "DESCRIBE trust_NUH"),
+    DBI::dbGetQuery(pool, paste0("DESCRIBE ", principal_table))
+  )
+
+  # LPT
+  expect_identical(
+    DBI::dbGetQuery(pool, "DESCRIBE trust_LPT"),
+    DBI::dbGetQuery(pool, paste0("DESCRIBE ", principal_table))
+  )
+
+  # NEAS
+  expect_identical(
+    DBI::dbGetQuery(pool, "DESCRIBE trust_NEAS"),
+    DBI::dbGetQuery(pool, paste0("DESCRIBE ", principal_table))
+  )
+})
diff --git a/tests/testthat/test-tidy_upload.R b/tests/testthat/test-tidy_upload.R
@@ -60,17 +60,17 @@ test_that("clean_dataframe works", {
 })
 
 
-test_that("tidy_trust_gosh works", {
+test_that("tidy_trust_nuh works", {
   data <- data.frame(
-    comment_id = 1:4,
-    age = c("31", "55", "77", NA)
+    comment_id = 1:6,
+    age = c(16, "31", "55", "77", NA, 'prefer not to say')
   )
 
-  result <- tidy_trust_gosh(data)
+  result <- tidy_trust_nuh(data)
 
   expect_true(inherits(result, "data.frame"))
   expect_true(inherits(result$age, "character"))
-  expect_equal(result$age, c("26 - 39", "40 - 64", "65 - 79", NA))
+  expect_equal(result$age, c("16 - 25", "26 - 35", "46 - 55", "Over 65", NA_character_, NA_character_))
 })
 
 test_that("tidy_trust_neas works", {