From 4af99057673d2b92ec430a1056adc84cc78f143a Mon Sep 17 00:00:00 2001 From: Jeff Thompson <160783290+jthompson-arcus@users.noreply.github.com> Date: Fri, 8 Nov 2024 09:14:09 -0500 Subject: [PATCH 01/21] Ignore `.Renviron` on git --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index b359fbb1..38567ec0 100644 --- a/.gitignore +++ b/.gitignore @@ -2,6 +2,7 @@ .Rhistory .RData .Ruserdata +.Renviron *.html *.tmp ~$* From 7af507cb2855113a3b90590140f762fe6dfc0f93 Mon Sep 17 00:00:00 2001 From: Jeff Thompson <160783290+jthompson-arcus@users.noreply.github.com> Date: Fri, 8 Nov 2024 09:25:57 -0500 Subject: [PATCH 02/21] Initialize `db_get_table()` --- R/fct_db_collect_data.R | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/R/fct_db_collect_data.R b/R/fct_db_collect_data.R index ccfe4650..039f17f5 100644 --- a/R/fct_db_collect_data.R +++ b/R/fct_db_collect_data.R @@ -82,6 +82,15 @@ db_slice_rows <- function( dplyr::slice_tail(df, n = 1, by = dplyr::all_of(c(group_vars, slice_vars))) } +db_get_table <- function(db_path, db_table = "all_review_data") { + stopifnot(is.character(db_path)) + stopifnot(is.character(db_table)) + + con <- get_db_connection(db_path) + dplyr::tbl(con, db_table) |> + dplyr::collect() +} + #' Collect query data #' From 2191a04d1ae6267187a1473b3af7595e0a7f07ab Mon Sep 17 00:00:00 2001 From: Jeff Thompson <160783290+jthompson-arcus@users.noreply.github.com> Date: Fri, 8 Nov 2024 09:26:29 -0500 Subject: [PATCH 03/21] Use `db_get_table()` instead of `db_slice_rows()` to retrieve review rows --- R/app_server.R | 2 +- R/mod_review_data_fct_helpers.R | 1 - R/mod_review_forms.R | 2 +- 3 files changed, 2 insertions(+), 3 deletions(-) diff --git a/R/app_server.R b/R/app_server.R index d7f24b65..9c20dad6 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -58,7 +58,7 @@ app_server <- function( ) # think of using the pool package, but functions such as row_update are not yet supported. r <- reactiveValues( - review_data = db_slice_rows(user_db, db_table = "all_review_data"), + review_data = db_get_table(user_db, db_table = "all_review_data"), query_data = collect_query_data(user_db), filtered_subjects = app_vars$subject_id, filtered_data = app_data, diff --git a/R/mod_review_data_fct_helpers.R b/R/mod_review_data_fct_helpers.R index 72ddc565..950c29b3 100644 --- a/R/mod_review_data_fct_helpers.R +++ b/R/mod_review_data_fct_helpers.R @@ -177,7 +177,6 @@ summarize_review_data <- function( .by = dplyr::all_of(common_vars) ) |> dplyr::distinct() - # db_slice_rows(slice_vars = date_time_vars, group_vars = common_vars) } data } diff --git a/R/mod_review_forms.R b/R/mod_review_forms.R index cca0d237..5f8bf9a8 100644 --- a/R/mod_review_forms.R +++ b/R/mod_review_forms.R @@ -283,7 +283,7 @@ mod_review_forms_server <- function( id = ns("review_save_error"), type = "error" ) - r$review_data <- db_slice_rows(db_path, db_table = "all_review_data") + r$review_data <- db_get_table(db_path, db_table = "all_review_data") }) } showNotification("Input saved successfully", duration = 1, type = "message") From 0582b3b18ec38b93bc3d20486d69deca4a9c631f Mon Sep 17 00:00:00 2001 From: Jeff Thompson <160783290+jthompson-arcus@users.noreply.github.com> Date: Fri, 8 Nov 2024 09:59:29 -0500 Subject: [PATCH 04/21] Use `db_get_table()` instead of `db_slice_rows()` in tests --- tests/testthat/_snaps/mod_review_forms.md | 31 +++++------------------ tests/testthat/test-app_feature_02.R | 2 +- tests/testthat/test-mod_query_add.R | 6 ++--- tests/testthat/test-mod_review_forms.R | 26 +++++++++---------- 4 files changed, 23 insertions(+), 42 deletions(-) diff --git a/tests/testthat/_snaps/mod_review_forms.md b/tests/testthat/_snaps/mod_review_forms.md index a0611544..5300ef15 100644 --- a/tests/testthat/_snaps/mod_review_forms.md +++ b/tests/testthat/_snaps/mod_review_forms.md @@ -6,33 +6,14 @@ # A tibble: 2 x 12 id subject_id event_name item_group form_repeat item_name - 1 2 361 Visit 5 Vital signs 4 Systolic blood pressure - 2 1 885 Any visit Adverse events 1 AE Number + 1 1 885 Any visit Adverse events 1 AE Number + 2 2 361 Visit 5 Vital signs 4 Systolic blood pressure event_date edit_date_time reviewed comment reviewer - 1 2023-07-01 2023-08-30 01:01:01 No "" "" - 2 2023-08-15 2023-09-30 01:01:01 Yes "" "test_name (Medical Monitor)" + 1 2023-08-15 2023-09-30 01:01:01 Yes "" "test_name (Medical Monitor)" + 2 2023-07-01 2023-08-30 01:01:01 No "" "" status - 1 new - 2 old - ---- - - Code - print(dplyr::select(r$review_data, -timestamp), width = Inf) - Output - # A tibble: 2 x 12 - id subject_id event_name item_group form_repeat item_name - - 1 2 361 Visit 5 Vital signs 4 Systolic blood pressure - 2 1 885 Any visit Adverse events 1 AE Number - event_date edit_date_time reviewed comment - - 1 2023-07-01 2023-08-30 01:01:01 No "" - 2 2023-08-15 2023-09-30 01:01:01 No "test review" - reviewer status - - 1 "" new - 2 "test_name (Medical Monitor)" new + 1 old + 2 new diff --git a/tests/testthat/test-app_feature_02.R b/tests/testthat/test-app_feature_02.R index 3c8a36b7..3fac4e6f 100644 --- a/tests/testthat/test-app_feature_02.R +++ b/tests/testthat/test-app_feature_02.R @@ -41,7 +41,7 @@ describe( user_db <- app$get_value(export = "user_db") - active_form_data <- db_slice_rows(user_db) |> + active_form_data <- db_get_table(user_db) |> dplyr::filter( subject_id == app$get_value(export = "active_participant"), item_group == app$get_value(export = "active_form") diff --git a/tests/testthat/test-mod_query_add.R b/tests/testthat/test-mod_query_add.R index af485018..32aa9322 100644 --- a/tests/testthat/test-mod_query_add.R +++ b/tests/testthat/test-mod_query_add.R @@ -262,7 +262,7 @@ describe( user_name = "test user", user_role = "Medical Monitor", subject_id = 885, - review_data = db_slice_rows(temp_path) + review_data = db_get_table(temp_path) ), active_form = reactiveVal("Adverse events"), db_path = temp_path, @@ -317,7 +317,7 @@ describe( user_name = "", user_role = "Medical Monitor", subject_id = 885, - review_data = db_slice_rows(temp_path) + review_data = db_get_table(temp_path) ), active_form = reactiveVal("Adverse events"), db_path = temp_path, @@ -369,7 +369,7 @@ describe( user_name = "test user", user_role = "", subject_id = 885, - review_data = db_slice_rows(temp_path) + review_data = db_get_table(temp_path) ), active_form = reactiveVal("Adverse events"), db_path = temp_path, diff --git a/tests/testthat/test-mod_review_forms.R b/tests/testthat/test-mod_review_forms.R index a1ade7d8..d32f5d71 100644 --- a/tests/testthat/test-mod_review_forms.R +++ b/tests/testthat/test-mod_review_forms.R @@ -64,7 +64,7 @@ describe( user_name = "test_name", user_role = "Medical Monitor", subject_id = "885", - review_data = db_slice_rows(temp_path) + review_data = db_get_table(temp_path) ), active_form = reactiveVal("Adverse events"), active_tab = reactiveVal("Common forms"), @@ -87,9 +87,9 @@ describe( dplyr::collect() }) - expect_equal(r$review_data, db_slice_rows(db_path)) + expect_equal(r$review_data, db_get_table(db_path)) # new process expects the app data to be equal to DB data - expect_equal(r$review_data, dplyr::arrange(db_reviewdata, edit_date_time)) + expect_equal(r$review_data, db_reviewdata) # review table should only have one row in the DB containing the new reviewed = "Yes" expect_equal(with(db_reviewdata, reviewed[subject_id == "885"]), c("Yes") ) # log table should only have one row in the DB containing the old reviewed = "No" @@ -129,8 +129,8 @@ describe( r_id <- with(db_reviewdata, id[subject_id == "885"]) expect_equal(with(db_reviewlogdata, comment[review_id == r_id]), c("", "")) expect_equal(with(db_reviewlogdata, reviewed[review_id == r_id]), c("No", "Yes")) - expect_equal(r$review_data, db_slice_rows(db_path)) - expect_equal(r$review_data, dplyr::arrange(db_reviewdata, edit_date_time)) + expect_equal(r$review_data, db_get_table(db_path)) + expect_equal(r$review_data, db_reviewdata) expect_snapshot(print(dplyr::select(r$review_data, -timestamp), width = Inf)) }) } @@ -165,7 +165,7 @@ describe( user_name = "test_name", user_role = "Medical Monitor", subject_id = "885", - review_data = db_slice_rows(temp_path) + review_data = db_get_table(temp_path) ), active_form = reactiveVal("Adverse events"), active_tab = reactiveVal("Common events"), @@ -209,7 +209,7 @@ describe( expect_true(app$get_js("document.getElementById('test-review_comment').disabled;")) # review status and reviewer is saved as expected - saved_review_row <- db_slice_rows(temp_path) |> + saved_review_row <- db_get_table(temp_path) |> dplyr::filter(subject_id == "885") expect_equal(saved_review_row$status, "old") expect_equal(saved_review_row$reviewer, "test_name (Medical Monitor)") @@ -244,7 +244,7 @@ describe( user_name = "test_name", user_role = "Medical Monitor", subject_id = "885", - review_data = db_slice_rows(temp_path) + review_data = db_get_table(temp_path) ), active_form = reactiveVal("Adverse events"), active_tab = reactiveVal("Common forms"), @@ -286,7 +286,7 @@ describe( user_name = "test_name", user_role = "Medical Monitor", subject_id = "885", - review_data = db_slice_rows(temp_path) + review_data = db_get_table(temp_path) ), active_form = reactiveVal("Adverse events"), active_tab = reactiveVal("Common forms"), @@ -325,7 +325,7 @@ describe( user_name = "test_name", user_role = "Medical Monitor", subject_id = "885", - review_data = db_slice_rows(temp_path) + review_data = db_get_table(temp_path) ), active_form = reactiveVal("Adverse events"), active_tab = reactiveVal("Common forms"), @@ -390,7 +390,7 @@ describe( user_name = NULL, user_role = "Medical Monitor", subject_id = "885", - review_data = db_slice_rows(temp_path) + review_data = db_get_table(temp_path) ), active_form = reactiveVal("Adverse events"), active_tab = reactiveVal("Common events"), @@ -452,7 +452,7 @@ describe( { temp_path <- withr::local_tempfile(fileext = ".sqlite") file.copy(test_path("fixtures", "review_testdb.sqlite"), temp_path) - rev_data <- db_slice_rows(temp_path) + rev_data <- db_get_table(temp_path) local_mocked_bindings( db_save_review = function(...) "no data saved in database" ) @@ -519,7 +519,7 @@ describe( user_name = "test_name", user_role = "restricted_role", subject_id = "885", - review_data = db_slice_rows(temp_path) + review_data = db_get_table(temp_path) ), active_form = reactiveVal("Adverse events"), active_tab = reactiveVal("Common events"), From b370ff50c0bde33f5fb03bc28459074d08d219b4 Mon Sep 17 00:00:00 2001 From: Jeff Thompson <160783290+jthompson-arcus@users.noreply.github.com> Date: Fri, 8 Nov 2024 10:26:58 -0500 Subject: [PATCH 05/21] Remove unneeded slicing and filtering --- R/fct_SQLite.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/R/fct_SQLite.R b/R/fct_SQLite.R index fb7e4e24..91a24c16 100644 --- a/R/fct_SQLite.R +++ b/R/fct_SQLite.R @@ -325,13 +325,11 @@ db_save_review <- function( dplyr::inner_join(dplyr::tbl(db_con, "row_ids"), by = review_by) |> # Filter below prevents unnecessarily overwriting the review status in forms # with mixed reviewed status (due to an edit by the investigators). - dplyr::filter(reviewed != new_review_state) |> dplyr::collect() if(nrow(new_review_rows) == 0){return( warning("Review state unaltered. No review will be saved.") )} new_review_rows <- new_review_rows |> - db_slice_rows(slice_vars = c("timestamp", "edit_date_time"), group_vars = common_vars) |> dplyr::select(-dplyr::all_of(cols_to_change)) |> # If there are multiple edits, make sure to only select the latest editdatetime for all items: # dplyr::slice_max(edit_date_time, by = dplyr::all_of(common_vars)) |> From f0837f273a2a7344ae29461780536f48f40dd967 Mon Sep 17 00:00:00 2001 From: Jeff Thompson <160783290+jthompson-arcus@users.noreply.github.com> Date: Fri, 8 Nov 2024 10:51:51 -0500 Subject: [PATCH 06/21] Capture second snapshot --- tests/testthat/_snaps/mod_review_forms.md | 19 +++++++++++++++++++ tests/testthat/test-mod_review_forms.R | 2 +- 2 files changed, 20 insertions(+), 1 deletion(-) diff --git a/tests/testthat/_snaps/mod_review_forms.md b/tests/testthat/_snaps/mod_review_forms.md index 5300ef15..628e776b 100644 --- a/tests/testthat/_snaps/mod_review_forms.md +++ b/tests/testthat/_snaps/mod_review_forms.md @@ -17,3 +17,22 @@ 1 old 2 new +--- + + Code + print(dplyr::select(r$review_data, -timestamp), width = Inf) + Output + # A tibble: 2 x 12 + id subject_id event_name item_group form_repeat item_name + + 1 1 885 Any visit Adverse events 1 AE Number + 2 2 361 Visit 5 Vital signs 4 Systolic blood pressure + event_date edit_date_time reviewed comment + + 1 2023-08-15 2023-09-30 01:01:01 No "test review" + 2 2023-07-01 2023-08-30 01:01:01 No "" + reviewer status + + 1 "test_name (Medical Monitor)" new + 2 "" new + diff --git a/tests/testthat/test-mod_review_forms.R b/tests/testthat/test-mod_review_forms.R index d32f5d71..3601fdfc 100644 --- a/tests/testthat/test-mod_review_forms.R +++ b/tests/testthat/test-mod_review_forms.R @@ -98,7 +98,7 @@ describe( expect_snapshot({ print(dplyr::select(r$review_data, -timestamp), width = Inf) }) - Sys.sleep(1) # because the timestamp only records seconds, + Sys.sleep(2) # because the timestamp only records seconds, # we should add delay here to prevent that the exact same timestamp is # created in the next step. The timestamp is needed for uniquely selecting the latest entry. # It would still work since it defaults to select the last row of the database, From 3e1a650eaf6f4ad876686c9ad63712c11c9d27d5 Mon Sep 17 00:00:00 2001 From: Jeff Thompson <160783290+jthompson-arcus@users.noreply.github.com> Date: Mon, 11 Nov 2024 13:33:29 -0500 Subject: [PATCH 07/21] Add trigger for update on id --- R/fct_SQLite.R | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/R/fct_SQLite.R b/R/fct_SQLite.R index 861c87c0..e9ae9e7b 100644 --- a/R/fct_SQLite.R +++ b/R/fct_SQLite.R @@ -164,6 +164,16 @@ db_add_log <- function(con) { edit_date_time = "CHAR", reviewed = "CHAR", comment = "CHAR", reviewer = "CHAR", timestamp = "CHAR", status = "CHAR", dml_type = "CHAR NOT NULL", dml_timestamp = "DATETIME DEFAULT CURRENT_TIMESTAMP")) + # This will trigger before any UPDATEs happen on all_review_data. Instead of + # allowing 'id' to be updated, it will throw an error. + rs <- DBI::dbSendStatement(con, paste( + "CREATE TRIGGER all_review_data_id_update_trigger", + "BEFORE UPDATE OF id ON all_review_data", + "BEGIN", + "SELECT RAISE(FAIL, 'all_review_data.id is read only');", + "END" + )) + DBI::dbClearResult(rs) rs <- DBI::dbSendStatement(con, paste( "CREATE TRIGGER all_review_data_update_log_trigger", "AFTER UPDATE ON all_review_data FOR EACH ROW", From 851a5ba058c15a79e2b3e60362d544221afc00e6 Mon Sep 17 00:00:00 2001 From: Jeff Thompson <160783290+jthompson-arcus@users.noreply.github.com> Date: Mon, 11 Nov 2024 14:06:35 -0500 Subject: [PATCH 08/21] Check DB version at run time --- R/fct_SQLite.R | 11 +++++++++++ R/run_app.R | 2 ++ 2 files changed, 13 insertions(+) diff --git a/R/fct_SQLite.R b/R/fct_SQLite.R index e9ae9e7b..85f4d63e 100644 --- a/R/fct_SQLite.R +++ b/R/fct_SQLite.R @@ -505,6 +505,17 @@ db_get_review <- function( }) } +db_get_version <- function(db_path) { + stopifnot(file.exists(db_path)) + con <- get_db_connection(db_path) + tryCatch({ + DBI::dbGetQuery(con, "SELECT version FROM db_version") |> + unlist(use.names = FALSE) + }, + error = \(e) {""} + ) +} + update_db_version <- function(db_path, version = "1.1") { stopifnot(file.exists(db_path)) version <- match.arg(version) diff --git a/R/run_app.R b/R/run_app.R index 3cadbe2d..2c6b8166 100644 --- a/R/run_app.R +++ b/R/run_app.R @@ -67,6 +67,8 @@ run_app <- function( warning("No user database found. New database will be created") db_create(get_review_data(data), db_path = user_db) } else{ + stopifnot("user_db version is not update to date" = + identical(db_version, db_get_version(user_db))) # Skip if not needed for faster testing: if(isTRUE(get_golem_config("app_prod"))){ db_update(get_review_data(data), db_path = user_db) From 485f464a637c6a83bf573bc764ae75e96e2695e6 Mon Sep 17 00:00:00 2001 From: Jeff Thompson <160783290+jthompson-arcus@users.noreply.github.com> Date: Mon, 11 Nov 2024 14:16:32 -0500 Subject: [PATCH 09/21] Update NEWS and version --- DESCRIPTION | 2 +- NEWS.md | 1 + inst/golem-config.yml | 2 +- 3 files changed, 3 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 7e508c44..b751b562 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: clinsight Title: ClinSight -Version: 0.1.0.9008 +Version: 0.1.0.9009 Authors@R: c( person("Leonard Daniël", "Samson", , "lsamson@gcp-service.com", role = c("cre", "aut"), comment = c(ORCID = "0000-0002-6252-7639")), diff --git a/NEWS.md b/NEWS.md index 54c9761c..20a44811 100644 --- a/NEWS.md +++ b/NEWS.md @@ -9,6 +9,7 @@ - Gave users ability to re-organized the column order in any table. - Added form type as a class to be used in `create_table()` to display tables. - Add a logging table to the DB for reviews. +- Simplify pulling data from DB for reviews. ## Bug fixes diff --git a/inst/golem-config.yml b/inst/golem-config.yml index e1d167ee..9bb6516e 100644 --- a/inst/golem-config.yml +++ b/inst/golem-config.yml @@ -1,6 +1,6 @@ default: golem_name: clinsight - golem_version: 0.1.0.9008 + golem_version: 0.1.0.9009 app_prod: no user_identification: test_user study_data: !expr clinsight::clinsightful_data From 0e266d77b8ed03c88f7ff172e84b2381bbfe62b0 Mon Sep 17 00:00:00 2001 From: Jeff Thompson <160783290+jthompson-arcus@users.noreply.github.com> Date: Mon, 18 Nov 2024 08:21:05 -0500 Subject: [PATCH 10/21] Use `DBI` directly instead of `tbl()` and `collect()` --- R/fct_db_collect_data.R | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/R/fct_db_collect_data.R b/R/fct_db_collect_data.R index 039f17f5..a6973716 100644 --- a/R/fct_db_collect_data.R +++ b/R/fct_db_collect_data.R @@ -87,8 +87,9 @@ db_get_table <- function(db_path, db_table = "all_review_data") { stopifnot(is.character(db_table)) con <- get_db_connection(db_path) - dplyr::tbl(con, db_table) |> - dplyr::collect() + sql <- "SELECT * FROM ?db_table" + query <- DBI::sqlInterpolate(con, sql, db_table = db_table[1]) + DBI::dbGetQuery(con, query) } From 140570218278c994178357df512a259a6d8b6ddd Mon Sep 17 00:00:00 2001 From: Jeff Thompson <160783290+jthompson-arcus@users.noreply.github.com> Date: Mon, 18 Nov 2024 08:23:09 -0500 Subject: [PATCH 11/21] Fix typo in `user_db` version check --- R/run_app.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/run_app.R b/R/run_app.R index 2c6b8166..f0d50c74 100644 --- a/R/run_app.R +++ b/R/run_app.R @@ -67,7 +67,7 @@ run_app <- function( warning("No user database found. New database will be created") db_create(get_review_data(data), db_path = user_db) } else{ - stopifnot("user_db version is not update to date" = + stopifnot("user_db version is not up to date" = identical(db_version, db_get_version(user_db))) # Skip if not needed for faster testing: if(isTRUE(get_golem_config("app_prod"))){ From 240c4e8068f9e3f2cf3ae159910dfc555f40a4c2 Mon Sep 17 00:00:00 2001 From: Jeff Thompson <160783290+jthompson-arcus@users.noreply.github.com> Date: Mon, 18 Nov 2024 08:35:32 -0500 Subject: [PATCH 12/21] Only update records with new status. --- R/fct_SQLite.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/fct_SQLite.R b/R/fct_SQLite.R index 85f4d63e..8d779515 100644 --- a/R/fct_SQLite.R +++ b/R/fct_SQLite.R @@ -335,6 +335,7 @@ db_save_review <- function( dplyr::inner_join(dplyr::tbl(db_con, "row_ids"), by = review_by) |> # Filter below prevents unnecessarily overwriting the review status in forms # with mixed reviewed status (due to an edit by the investigators). + dplyr::filter(reviewed != new_review_state) |> dplyr::collect() if(nrow(new_review_rows) == 0){return( warning("Review state unaltered. No review will be saved.") From 8085287e7c42dcb4e19e6cad4148006c25fbceb9 Mon Sep 17 00:00:00 2001 From: Jeff Thompson <160783290+jthompson-arcus@users.noreply.github.com> Date: Mon, 18 Nov 2024 08:40:24 -0500 Subject: [PATCH 13/21] Remove argument no longer used --- R/fct_SQLite.R | 5 ----- man/db_save_review.Rd | 3 --- 2 files changed, 8 deletions(-) diff --git a/R/fct_SQLite.R b/R/fct_SQLite.R index 8d779515..a85f0208 100644 --- a/R/fct_SQLite.R +++ b/R/fct_SQLite.R @@ -302,7 +302,6 @@ db_upsert <- function(con, data, idx_cols) { #' @param db_path Character vector. Path to the database. #' @param tables Character vector. Names of the tables within the database to #' save the review in. -#' @param common_vars A character vector containing the common key variables. #' @param review_by A character vector, containing the key variables to perform #' the review on. For example, the review can be performed on form level #' (writing the same review to all items in a form), or on item level, with a @@ -316,8 +315,6 @@ db_save_review <- function( rv_row, db_path, tables = c("all_review_data"), - common_vars = c("subject_id", "event_name", "item_group", - "form_repeat", "item_name"), review_by = c("subject_id", "item_group") ){ stopifnot(is.data.frame(rv_row)) @@ -342,8 +339,6 @@ db_save_review <- function( )} new_review_rows <- new_review_rows |> dplyr::select(-dplyr::all_of(cols_to_change)) |> - # If there are multiple edits, make sure to only select the latest editdatetime for all items: - # dplyr::slice_max(edit_date_time, by = dplyr::all_of(common_vars)) |> dplyr::bind_cols(rv_row[cols_to_change]) # bind_cols does not work in a db connection. cat("write updated review data to database\n") dplyr::copy_to(db_con, new_review_rows, "row_updates") diff --git a/man/db_save_review.Rd b/man/db_save_review.Rd index dbbbed19..c54cb39f 100644 --- a/man/db_save_review.Rd +++ b/man/db_save_review.Rd @@ -8,7 +8,6 @@ db_save_review( rv_row, db_path, tables = c("all_review_data"), - common_vars = c("subject_id", "event_name", "item_group", "form_repeat", "item_name"), review_by = c("subject_id", "item_group") ) } @@ -21,8 +20,6 @@ checked.} \item{tables}{Character vector. Names of the tables within the database to save the review in.} -\item{common_vars}{A character vector containing the common key variables.} - \item{review_by}{A character vector, containing the key variables to perform the review on. For example, the review can be performed on form level (writing the same review to all items in a form), or on item level, with a From a797883c46d4e2ef79eab4de904769c0956ac366 Mon Sep 17 00:00:00 2001 From: Jeff Thompson <160783290+jthompson-arcus@users.noreply.github.com> Date: Mon, 18 Nov 2024 08:42:36 -0500 Subject: [PATCH 14/21] Remove `common_vars` from tests --- tests/testthat/test-fct_SQLite.R | 3 --- 1 file changed, 3 deletions(-) diff --git a/tests/testthat/test-fct_SQLite.R b/tests/testthat/test-fct_SQLite.R index 9acc738b..dbb43415 100644 --- a/tests/testthat/test-fct_SQLite.R +++ b/tests/testthat/test-fct_SQLite.R @@ -268,7 +268,6 @@ describe( cbind(df, new_review), temp_path, tables = c("all_review_data"), - common_vars = c("key_col1", "item_group", "item_name"), review_by = c("key_col1", "item_group") ) expect_equal( @@ -319,7 +318,6 @@ describe( review_row, temp_path, tables = c("all_review_data"), - common_vars = c("key_col1", "item_group", "item_name"), review_by = c("key_col1", "item_group") ) expect_true(is.data.frame(dplyr::collect(dplyr::tbl(con, "all_review_data")))) @@ -351,7 +349,6 @@ describe( rbind(cbind(df, new_review), cbind(df, new_review)), temp_path, tables = "all_review_data", - common_vars = c("key_col1", "item_group", "item_name"), review_by = c("key_col1", "item_group") ) |> expect_warning() }) From 20f9528d6f9957a7554f89494bbc87d88c5eb9f3 Mon Sep 17 00:00:00 2001 From: Jeff Thompson <160783290+jthompson-arcus@users.noreply.github.com> Date: Mon, 18 Nov 2024 09:23:22 -0500 Subject: [PATCH 15/21] Repair tests with `db_get_table()` returning `data.frame` not `tibble` --- tests/testthat/_snaps/mod_review_forms.md | 46 ++++++++++------------- tests/testthat/test-mod_review_forms.R | 8 ++-- 2 files changed, 23 insertions(+), 31 deletions(-) diff --git a/tests/testthat/_snaps/mod_review_forms.md b/tests/testthat/_snaps/mod_review_forms.md index 628e776b..b50bd101 100644 --- a/tests/testthat/_snaps/mod_review_forms.md +++ b/tests/testthat/_snaps/mod_review_forms.md @@ -1,38 +1,30 @@ # mod_review_forms. Feature 2 | Save review of a form. As a user, I want to be able to save a review of a form in the database. After saving the review, all items of that form that are not yet reviewed should get a tag that the value was reviewed.: Scenario 1 - Save a review. Given test review data with at least an 'Adverse event' form with patient '885',and [user_name] set to 'test_name' and [user_role] to 'Medical Monitor'and [active_patient] set to '885', and [active_form] set to 'Adverse events', and [active_tab] set to 'Common forms', and [form_reviewed] set to FALSE, I expect that I can save a new review properly, with the result saved in the application being the same as the one saved in the database. Code - print(dplyr::select(r$review_data, -timestamp), width = Inf) + dplyr::select(r$review_data, -timestamp) Output - # A tibble: 2 x 12 - id subject_id event_name item_group form_repeat item_name - - 1 1 885 Any visit Adverse events 1 AE Number - 2 2 361 Visit 5 Vital signs 4 Systolic blood pressure - event_date edit_date_time reviewed comment reviewer - - 1 2023-08-15 2023-09-30 01:01:01 Yes "" "test_name (Medical Monitor)" - 2 2023-07-01 2023-08-30 01:01:01 No "" "" + id subject_id event_name item_group form_repeat item_name + 1 1 885 Any visit Adverse events 1 AE Number + 2 2 361 Visit 5 Vital signs 4 Systolic blood pressure + event_date edit_date_time reviewed comment reviewer + 1 2023-08-15 2023-09-30 01:01:01 Yes test_name (Medical Monitor) + 2 2023-07-01 2023-08-30 01:01:01 No status - - 1 old - 2 new + 1 old + 2 new --- Code - print(dplyr::select(r$review_data, -timestamp), width = Inf) + dplyr::select(r$review_data, -timestamp) Output - # A tibble: 2 x 12 - id subject_id event_name item_group form_repeat item_name - - 1 1 885 Any visit Adverse events 1 AE Number - 2 2 361 Visit 5 Vital signs 4 Systolic blood pressure - event_date edit_date_time reviewed comment - - 1 2023-08-15 2023-09-30 01:01:01 No "test review" - 2 2023-07-01 2023-08-30 01:01:01 No "" - reviewer status - - 1 "test_name (Medical Monitor)" new - 2 "" new + id subject_id event_name item_group form_repeat item_name + 1 1 885 Any visit Adverse events 1 AE Number + 2 2 361 Visit 5 Vital signs 4 Systolic blood pressure + event_date edit_date_time reviewed comment + 1 2023-08-15 2023-09-30 01:01:01 No test review + 2 2023-07-01 2023-08-30 01:01:01 No + reviewer status + 1 test_name (Medical Monitor) new + 2 new diff --git a/tests/testthat/test-mod_review_forms.R b/tests/testthat/test-mod_review_forms.R index 3601fdfc..a8c942dd 100644 --- a/tests/testthat/test-mod_review_forms.R +++ b/tests/testthat/test-mod_review_forms.R @@ -89,14 +89,14 @@ describe( expect_equal(r$review_data, db_get_table(db_path)) # new process expects the app data to be equal to DB data - expect_equal(r$review_data, db_reviewdata) + expect_equal(r$review_data, db_reviewdata, ignore_attr = TRUE) # review table should only have one row in the DB containing the new reviewed = "Yes" expect_equal(with(db_reviewdata, reviewed[subject_id == "885"]), c("Yes") ) # log table should only have one row in the DB containing the old reviewed = "No" r_id <- with(db_reviewdata, id[subject_id == "885"]) expect_equal(with(db_reviewlogdata, reviewed[review_id == r_id]), c("No") ) expect_snapshot({ - print(dplyr::select(r$review_data, -timestamp), width = Inf) + dplyr::select(r$review_data, -timestamp) }) Sys.sleep(2) # because the timestamp only records seconds, # we should add delay here to prevent that the exact same timestamp is @@ -130,8 +130,8 @@ describe( expect_equal(with(db_reviewlogdata, comment[review_id == r_id]), c("", "")) expect_equal(with(db_reviewlogdata, reviewed[review_id == r_id]), c("No", "Yes")) expect_equal(r$review_data, db_get_table(db_path)) - expect_equal(r$review_data, db_reviewdata) - expect_snapshot(print(dplyr::select(r$review_data, -timestamp), width = Inf)) + expect_equal(r$review_data, db_reviewdata, ignore_attr = TRUE) + expect_snapshot(dplyr::select(r$review_data, -timestamp)) }) } ) From 6fb21a6feb77adf8446b17da7fe291493de7b7a3 Mon Sep 17 00:00:00 2001 From: Jeff Thompson <160783290+jthompson-arcus@users.noreply.github.com> Date: Mon, 18 Nov 2024 09:37:00 -0500 Subject: [PATCH 16/21] Update `review_testdb.sqlite` --- tests/testthat/fixtures/make_review_testdb.R | 29 +++++++++---------- tests/testthat/fixtures/review_testdb.sqlite | Bin 16384 -> 16384 bytes 2 files changed, 14 insertions(+), 15 deletions(-) diff --git a/tests/testthat/fixtures/make_review_testdb.R b/tests/testthat/fixtures/make_review_testdb.R index 14fc363d..e719cca4 100644 --- a/tests/testthat/fixtures/make_review_testdb.R +++ b/tests/testthat/fixtures/make_review_testdb.R @@ -4,27 +4,26 @@ make_review_testdata <- function(){ data.frame( - subject_id = c("885", "361"), - event_name = c("Any visit", "Visit 5"), - item_group = c("Adverse events", "Vital signs"), - form_repeat = c(1, 4), - item_name = c("AE Number", "Systolic blood pressure"), - event_date = c("2023-08-15", "2023-07-01"), - edit_date_time = c("2023-09-30 01:01:01", "2023-08-30 01:01:01") + subject_id = c("885", "885", "361", "361"), + event_name = c("Any visit", "Any visit", "Visit 5", "Visit 6"), + item_group = c("Adverse events", "Adverse events", "Vital signs", "Vital signs"), + form_repeat = c(1, 2, 4, 5), + item_name = c("Atrial Fibrillation", "Cystitis", "Systolic blood pressure", "Systolic blood pressure"), + event_date = c("2023-08-15", "2023-09-01", "2023-07-01", "2023-08-01"), + edit_date_time = c("2023-09-30 01:01:01", "2023-10-01 01:01:01", "2023-08-30 01:01:01", "2023-08-02 01:01:01") ) |> dplyr::mutate( - reviewed = "No", - comment = "", - reviewer = "", - timestamp = "2000-01-01 01:01:01", - status = "new" + reviewed = c("Yes", "No", "Yes", "No"), + comment = c("test comment", "", "another comment", ""), + reviewer = c("Reviewer 1", "", "Reviewer 2", ""), + timestamp = c("2000-01-01 01:01:01", "", "2023-09-01 01:01:01", ""), + status = c("old", "new", "old", "new") ) } fixture_path <- system.file("tests/testthat/fixtures", package = "clinsight") -db_temp_connect(paste0(fixture_path, "/review_testdb.sqlite"), { - if ("all_review_data" %in% DBI::dbListTables(con)) - DBI::dbRemoveTable(con, "all_review_data") +unlink(file.path(fixture_path, "review_testdb.sqlite")) +db_temp_connect(file.path(fixture_path, "review_testdb.sqlite"), { db_add_primary_key(con, "all_review_data", make_review_testdata()) db_add_log(con) }) diff --git a/tests/testthat/fixtures/review_testdb.sqlite b/tests/testthat/fixtures/review_testdb.sqlite index 89f1f78ffdbfcc81c0ce0435a734da76440f4f22..6c38306c31f908aece8c245a9f885e78fd262377 100644 GIT binary patch delta 618 zcmZo@U~Fh$oFFa8%D}+D0>m)DGEv7^oRvYZs(=?L#LAV-z&DZ4p63$xPp;&Rjc++O z+i*`~)M^Z4VVCyT=4i4lDauSwPc2H!$%!vYEz3+Tk55S~NsP}-i7zbxvQj6fbDPz} zdGS!?3Qn$W{z0w^p#d(AA+8GkZVH(x3jTfyXvP4QxqJF41iSjUI)^9(IeG@WYPdOi z`sgUAqp8#b>d!1zC`wICQOM8BsZ`grR&e!mY06?|7dPH~gJ(A*Bje^NdGUv8VmCB@(LT98HQyRXO<|Kg=Ll`<|q_rrsoy2 zPWF+P)wa+zFf=kSGS)Q!vWyfA46VS(FF!A}ypf9;ZjP|F;$#zfpZdtu;>5iCl8n?M zh2;F)+|<01AaEc7`9=_PEP*D%&B@P631$KsBCp9P3w4Zzg{fm+r9v6VL5?Y9sYS)9 z3aMp4gNm7)D~n4qOEQZQ27y_I25=+YfX;)sjhzu}ET^%ev9Kx-<2Ke27)3x&yJaR7 uW#;50mSpDVO+GCzs}J-_2@qlU0~j6#ARFP90__C)W0S&venyr>1_A))_N|!! delta 226 zcmZo@U~Fh$oFFa8!@$760>m)DJ5k42l!rmDs(=?L#KLXEz-P}lk>?V(&1OM?6I`2< zxu!8PH)XMGzRI(Yk&$`x6utsR4kmsz2L2iRYMTWWr1<#?nD`ikrIi`26^#XXc_%NH z^HKN9H!?6V&^0gwA_W6OD=^ASEl* Date: Mon, 18 Nov 2024 09:59:29 -0500 Subject: [PATCH 17/21] Update `mod_review_forms` test with new testing DB --- tests/testthat/_snaps/mod_review_forms.md | 40 +++++++---- tests/testthat/test-mod_review_forms.R | 87 ++++++++++++++--------- 2 files changed, 79 insertions(+), 48 deletions(-) diff --git a/tests/testthat/_snaps/mod_review_forms.md b/tests/testthat/_snaps/mod_review_forms.md index b50bd101..646ff879 100644 --- a/tests/testthat/_snaps/mod_review_forms.md +++ b/tests/testthat/_snaps/mod_review_forms.md @@ -4,14 +4,20 @@ dplyr::select(r$review_data, -timestamp) Output id subject_id event_name item_group form_repeat item_name - 1 1 885 Any visit Adverse events 1 AE Number - 2 2 361 Visit 5 Vital signs 4 Systolic blood pressure - event_date edit_date_time reviewed comment reviewer - 1 2023-08-15 2023-09-30 01:01:01 Yes test_name (Medical Monitor) - 2 2023-07-01 2023-08-30 01:01:01 No - status - 1 old - 2 new + 1 1 885 Any visit Adverse events 1 Atrial Fibrillation + 2 2 885 Any visit Adverse events 2 Cystitis + 3 3 361 Visit 5 Vital signs 4 Systolic blood pressure + 4 4 361 Visit 6 Vital signs 5 Systolic blood pressure + event_date edit_date_time reviewed comment + 1 2023-08-15 2023-09-30 01:01:01 Yes test comment + 2 2023-09-01 2023-10-01 01:01:01 Yes + 3 2023-07-01 2023-08-30 01:01:01 Yes another comment + 4 2023-08-01 2023-08-02 01:01:01 No + reviewer status + 1 Reviewer 1 old + 2 test_name (Medical Monitor) old + 3 Reviewer 2 old + 4 new --- @@ -19,12 +25,18 @@ dplyr::select(r$review_data, -timestamp) Output id subject_id event_name item_group form_repeat item_name - 1 1 885 Any visit Adverse events 1 AE Number - 2 2 361 Visit 5 Vital signs 4 Systolic blood pressure - event_date edit_date_time reviewed comment - 1 2023-08-15 2023-09-30 01:01:01 No test review - 2 2023-07-01 2023-08-30 01:01:01 No + 1 1 885 Any visit Adverse events 1 Atrial Fibrillation + 2 2 885 Any visit Adverse events 2 Cystitis + 3 3 361 Visit 5 Vital signs 4 Systolic blood pressure + 4 4 361 Visit 6 Vital signs 5 Systolic blood pressure + event_date edit_date_time reviewed comment + 1 2023-08-15 2023-09-30 01:01:01 No test review + 2 2023-09-01 2023-10-01 01:01:01 No test review + 3 2023-07-01 2023-08-30 01:01:01 Yes another comment + 4 2023-08-01 2023-08-02 01:01:01 No reviewer status 1 test_name (Medical Monitor) new - 2 new + 2 test_name (Medical Monitor) new + 3 Reviewer 2 old + 4 new diff --git a/tests/testthat/test-mod_review_forms.R b/tests/testthat/test-mod_review_forms.R index a8c942dd..763f1bf0 100644 --- a/tests/testthat/test-mod_review_forms.R +++ b/tests/testthat/test-mod_review_forms.R @@ -77,6 +77,22 @@ describe( testServer( mod_review_forms_server, args = testargs, { ns <- session$ns + + ## patient has two rows: AF and Cystitis. AF is already reviewed by someone else: + expect_equal( + data.frame( + item_name = c("Atrial Fibrillation", "Cystitis"), + status = c("old", "new") + ), + db_temp_connect(db_path, { + DBI::dbGetQuery( + con, + paste0("SELECT item_name, status FROM all_review_data ", + "WHERE subject_id = '885'") + ) + }) + ) + session$setInputs(form_reviewed = TRUE, save_review = 1) db_reviewdata <- db_temp_connect(db_path, { dplyr::tbl(con, "all_review_data") |> @@ -91,9 +107,12 @@ describe( # new process expects the app data to be equal to DB data expect_equal(r$review_data, db_reviewdata, ignore_attr = TRUE) # review table should only have one row in the DB containing the new reviewed = "Yes" - expect_equal(with(db_reviewdata, reviewed[subject_id == "885"]), c("Yes") ) + expect_equal( + with(db_reviewdata, reviewed[subject_id == "885" & item_name == "Cystitis"]), + "Yes" + ) # log table should only have one row in the DB containing the old reviewed = "No" - r_id <- with(db_reviewdata, id[subject_id == "885"]) + r_id <- with(db_reviewdata, id[subject_id == "885" & item_name == "Cystitis"]) expect_equal(with(db_reviewlogdata, reviewed[review_id == r_id]), c("No") ) expect_snapshot({ dplyr::select(r$review_data, -timestamp) @@ -115,6 +134,14 @@ describe( review_comment = "test review", save_review = 2 ) + + updated_rows_db <- db_get_review( + db_path, subject = "885", form = "Adverse events" + ) + + expect_equal(updated_rows_db$comment, c("test review", "test review")) + expect_equal(updated_rows_db$reviewed, c("No", "No")) + db_reviewdata <- db_temp_connect(db_path, { dplyr::tbl(con, "all_review_data") |> dplyr::collect() @@ -124,11 +151,11 @@ describe( dplyr::collect() }) - expect_equal(with(db_reviewdata, comment[subject_id == "885"]), c("test review")) - expect_equal(with(db_reviewdata, reviewed[subject_id == "885"]), c("No")) + expect_equal(with(db_reviewdata, comment[subject_id == "885"]), c("test review", "test review")) + expect_equal(with(db_reviewdata, reviewed[subject_id == "885"]), c("No", "No")) r_id <- with(db_reviewdata, id[subject_id == "885"]) - expect_equal(with(db_reviewlogdata, comment[review_id == r_id]), c("", "")) - expect_equal(with(db_reviewlogdata, reviewed[review_id == r_id]), c("No", "Yes")) + expect_equal(with(db_reviewlogdata, comment[review_id %in% r_id]), c("", "test comment", "")) + expect_equal(with(db_reviewlogdata, reviewed[review_id %in% r_id]), c("No", "Yes", "Yes")) expect_equal(r$review_data, db_get_table(db_path)) expect_equal(r$review_data, db_reviewdata, ignore_attr = TRUE) expect_snapshot(dplyr::select(r$review_data, -timestamp)) @@ -209,10 +236,9 @@ describe( expect_true(app$get_js("document.getElementById('test-review_comment').disabled;")) # review status and reviewer is saved as expected - saved_review_row <- db_get_table(temp_path) |> - dplyr::filter(subject_id == "885") - expect_equal(saved_review_row$status, "old") - expect_equal(saved_review_row$reviewer, "test_name (Medical Monitor)") + saved_review_row <- db_get_review(temp_path, subject = "885", form = "Adverse events") + expect_equal(saved_review_row$status, c("old", "old")) + expect_equal(saved_review_row$reviewer, c("Reviewer 1", "test_name (Medical Monitor)")) } ) } @@ -259,8 +285,12 @@ describe( ns <- session$ns session$setInputs(form_reviewed = FALSE) expect_equal( - review_data_active(), - dplyr::filter(r$review_data, subject_id == "885", item_group == "Adverse events") |> + review_data_active(), + dplyr::filter( + r$review_data, subject_id == "885", + item_group == "Adverse events", + edit_date_time == max(edit_date_time) + ) |> dplyr::select(subject_id, item_group, edit_date_time, reviewed, comment, status) ) expect_equal(review_data_active()$item_group, "Adverse events") @@ -339,19 +369,13 @@ describe( mod_review_forms_server, args = testargs, { ns <- session$ns active_form("no_data_form") - data_before_save <- r$review_data - db_before_save <- db_temp_connect(db_path, { - dplyr::tbl(con, "all_review_data") |> - dplyr::collect() - }) + data_before_saving <- r$review_data + db_before_save <- db_get_table(db_path) session$setInputs(save_review = 1) expect_error(output[["save_review_error"]], "Nothing to review") - expect_equal(r$review_data, data_before_save) - db_reviewdata <- db_temp_connect(db_path, { - dplyr::tbl(con, "all_review_data") |> - dplyr::collect() - }) - expect_equal(db_reviewdata, db_before_save) + expect_equal(r$review_data, data_before_saving) + db_after_saving <- db_get_table(db_path) + expect_equal(db_after_saving, data_before_saving) }) } ) @@ -410,6 +434,7 @@ describe( height = 955 ) withr::defer(app$stop()) + db_before_saving <- db_get_table(temp_path) app$wait_for_idle(2500) app$click("test-form_reviewed") @@ -419,11 +444,8 @@ describe( app$expect_values() # review status and reviewer is saved as expected - saved_review_row <- db_get_review( - temp_path, subject = "885", form = "Adverse events" - ) - expect_equal(saved_review_row$status, "new") - expect_equal(saved_review_row$reviewer, "") + db_after_saving <- db_get_table(temp_path) + expect_equal(db_after_saving, db_before_saving) } ) @@ -474,15 +496,12 @@ describe( testServer( mod_review_forms_server, args = testargs, { ns <- session$ns + db_before_saving <- db_get_table(db_path) session$setInputs(form_reviewed = TRUE, save_review = 1) - db_reviewdata <- db_temp_connect(db_path, { - dplyr::tbl(con, "all_review_data") |> - dplyr::collect() - }) + db_after_saving <- db_get_table(db_path) expect_true(review_save_error()) expect_equal(r$review_data, rev_data) - # it should still have one row in the DB with review= 'No' - expect_equal(with(db_reviewdata, reviewed[subject_id == "885"]), "No" ) + expect_equal(db_after_saving, db_before_saving) }) } ) From c6ef19cfda5efffbe1b3264e1584c58c1c53e92b Mon Sep 17 00:00:00 2001 From: Jeff Thompson <160783290+jthompson-arcus@users.noreply.github.com> Date: Mon, 18 Nov 2024 10:20:17 -0500 Subject: [PATCH 18/21] Update `all_review_data_id_update_trigger` to include `idx_cols` --- R/fct_SQLite.R | 4 ++-- tests/testthat/fixtures/review_testdb.sqlite | Bin 16384 -> 16384 bytes 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/fct_SQLite.R b/R/fct_SQLite.R index a85f0208..1b66c3b6 100644 --- a/R/fct_SQLite.R +++ b/R/fct_SQLite.R @@ -168,9 +168,9 @@ db_add_log <- function(con) { # allowing 'id' to be updated, it will throw an error. rs <- DBI::dbSendStatement(con, paste( "CREATE TRIGGER all_review_data_id_update_trigger", - "BEFORE UPDATE OF id ON all_review_data", + sprintf("BEFORE UPDATE OF %s ON all_review_data", paste(c("id", idx_cols), collapse = ", ")), "BEGIN", - "SELECT RAISE(FAIL, 'all_review_data.id is read only');", + sprintf("SELECT RAISE(FAIL, 'Fields %s are read only');", paste(c("id", idx_cols), collapse = ", ")), "END" )) DBI::dbClearResult(rs) diff --git a/tests/testthat/fixtures/review_testdb.sqlite b/tests/testthat/fixtures/review_testdb.sqlite index 6c38306c31f908aece8c245a9f885e78fd262377..d98f6b27e9ab2633f7d9a3efc287535eaf53c5d5 100644 GIT binary patch delta 194 zcmZo@U~Fh$oRG=O`I&)lBA-3aCGJkn&l?+SIX5SBO=IM0a${ka_SfcUk)7PnB{o@- zC)Gwrp|~_DD>b$`6cUS4Hy`A&HwFL>Y(y3S delta 82 zcmV-Y0ImOkfB}Gj0g!183S$5ckq$o$(hK-bYU)OWFTpCv%w5MGcJxAzW@LL From 1a85f40715490ee9483d1f9cb4a1bb6b881e18fd Mon Sep 17 00:00:00 2001 From: Jeff Thompson <160783290+jthompson-arcus@users.noreply.github.com> Date: Mon, 18 Nov 2024 10:53:17 -0500 Subject: [PATCH 19/21] Add `keys` argument to `db_add_log()` --- R/fct_SQLite.R | 6 +++--- tests/testthat/fixtures/make_review_testdb.R | 2 +- tests/testthat/fixtures/review_testdb.sqlite | Bin 16384 -> 20480 bytes tests/testthat/test-fct_SQLite.R | 16 ++++++++-------- 4 files changed, 12 insertions(+), 12 deletions(-) diff --git a/R/fct_SQLite.R b/R/fct_SQLite.R index 1b66c3b6..eb3b366f 100644 --- a/R/fct_SQLite.R +++ b/R/fct_SQLite.R @@ -158,7 +158,7 @@ db_add_primary_key <- function(con, name, value, keys = NULL) { #' @param con A DBI Connection to the SQLite DB #' #' @keywords internal -db_add_log <- function(con) { +db_add_log <- function(con, keys = c("id", idx_cols)) { DBI::dbCreateTable(con, "all_review_data_log", c(id = "INTEGER PRIMARY KEY AUTOINCREMENT", review_id = "INTEGER NOT NULL", edit_date_time = "CHAR", reviewed = "CHAR", comment = "CHAR", @@ -168,9 +168,9 @@ db_add_log <- function(con) { # allowing 'id' to be updated, it will throw an error. rs <- DBI::dbSendStatement(con, paste( "CREATE TRIGGER all_review_data_id_update_trigger", - sprintf("BEFORE UPDATE OF %s ON all_review_data", paste(c("id", idx_cols), collapse = ", ")), + sprintf("BEFORE UPDATE OF %s ON all_review_data", paste(keys, collapse = ", ")), "BEGIN", - sprintf("SELECT RAISE(FAIL, 'Fields %s are read only');", paste(c("id", idx_cols), collapse = ", ")), + sprintf("SELECT RAISE(FAIL, 'Fields %s are read only');", paste(keys, collapse = ", ")), "END" )) DBI::dbClearResult(rs) diff --git a/tests/testthat/fixtures/make_review_testdb.R b/tests/testthat/fixtures/make_review_testdb.R index e719cca4..d20827ac 100644 --- a/tests/testthat/fixtures/make_review_testdb.R +++ b/tests/testthat/fixtures/make_review_testdb.R @@ -24,6 +24,6 @@ make_review_testdata <- function(){ fixture_path <- system.file("tests/testthat/fixtures", package = "clinsight") unlink(file.path(fixture_path, "review_testdb.sqlite")) db_temp_connect(file.path(fixture_path, "review_testdb.sqlite"), { - db_add_primary_key(con, "all_review_data", make_review_testdata()) + db_add_primary_key(con, "all_review_data", make_review_testdata(), idx_cols) db_add_log(con) }) diff --git a/tests/testthat/fixtures/review_testdb.sqlite b/tests/testthat/fixtures/review_testdb.sqlite index d98f6b27e9ab2633f7d9a3efc287535eaf53c5d5..8767fdc6c0e6affcd95ade24e0636f0d57cafe71 100644 GIT binary patch delta 286 zcmZo@U~E{xI6+#Fje&uI6^LPgb)t^3BpZWXRRJ$hh>g>Wfo~$8J?}IgO|A!=UK<-P zad0&Yv$0DDYIC%jPL}5q+bqmg!N|zExrf_>k&$KcRURWo*2(+%WG8>%VcD$7E5<0? zsK(4LZmiANSe==dl3J0OQV~CS0iT>Li*t~xV~DFlsGnzGsH=jfpNngR0!TJ7Cnvrr zwJbBWJU%6{BvHZNPXS#>W3m8`)n+@sLy7`iKzFk68#C}{@*DG?=AXY=P(hiW!<1cE zTA9(Bak8tNE+-3|w-m@@)@B!$*JPAsoNOqs%*kW|;&B>t0(nxC7s?ASG7ta&F6u(V delta 95 zcmZozz}V2hI6+#Fm4ShQ1&CpQWulI;I4gr*RRJ$hh?Vm*1K&hGd!9?&ot&RH3kuY7 pGB*peZuaGz%E-vF`7xIVBO~)<9UdbfC!WWgakD+&LB&N50su}O6fFP% diff --git a/tests/testthat/test-fct_SQLite.R b/tests/testthat/test-fct_SQLite.R index dbb43415..6477ede7 100644 --- a/tests/testthat/test-fct_SQLite.R +++ b/tests/testthat/test-fct_SQLite.R @@ -117,7 +117,7 @@ describe( con <- get_db_connection(temp_path) db_add_primary_key(con, "all_review_data", cbind(old_data, review_cols), comvars) - db_add_log(con) + db_add_log(con, c("id", comvars)) DBI::dbWriteTable(con, "db_synch_time", data.frame("synch_time" = "2024-01-01 01:01:01 UTC")) df_old <- cbind(id = 1, old_data, review_cols) @@ -144,7 +144,7 @@ describe( temp_path <- withr::local_tempfile(fileext = ".sqlite") con <- get_db_connection(temp_path) db_add_primary_key(con, "all_review_data", cbind(old_data, review_cols), comvars) - db_add_log(con) + db_add_log(con, c("id", comvars)) DBI::dbWriteTable(con, "db_synch_time", data.frame("synch_time" = "2024-01-01 01:01:01 UTC")) log_old <- DBI::dbGetQuery(con, "SELECT * FROM all_review_data_log") @@ -182,7 +182,7 @@ describe( temp_path <- withr::local_tempfile(fileext = ".sqlite") con <- get_db_connection(temp_path) db_add_primary_key(con, "all_review_data", cbind(old_data, review_cols), comvars) - db_add_log(con) + db_add_log(con, c("id", comvars)) DBI::dbWriteTable(con, "db_synch_time", data.frame("synch_time" = "2024-01-01 01:01:01 UTC")) rev_data <- old_data |> @@ -203,7 +203,7 @@ describe( rev_data <- cbind(old_data, review_cols) attr(rev_data, "synch_time") <- synch_time db_add_primary_key(con, "all_review_data", rev_data, comvars) - db_add_log(con) + db_add_log(con, c("id", comvars)) DBI::dbWriteTable(con, "db_synch_time", data.frame("synch_time" = synch_time)) log_old <- DBI::dbGetQuery(con, "SELECT * FROM all_review_data_log") @@ -262,7 +262,7 @@ describe( temp_path <- withr::local_tempfile(fileext = ".sqlite") con <- get_db_connection(temp_path) db_add_primary_key(con, "all_review_data", cbind(df, old_review)) - db_add_log(con) + db_add_log(con, "id") db_save_review( cbind(df, new_review), @@ -313,7 +313,7 @@ describe( temp_path <- withr::local_tempfile(fileext = ".sqlite") con <- get_db_connection(temp_path) db_add_primary_key(con, "all_review_data", cbind(df, old_review)) - db_add_log(con) + db_add_log(con, "id") db_save_review( review_row, temp_path, @@ -344,7 +344,7 @@ describe( con <- get_db_connection(temp_path) db_add_primary_key(con, "all_review_data", cbind(df, old_review)) - db_add_log(con) + db_add_log(con, "id") db_save_review( rbind(cbind(df, new_review), cbind(df, new_review)), temp_path, @@ -436,7 +436,7 @@ describe("db_get_review can collect latest review data from a database", { ) |> dplyr::as_tibble() db_add_primary_key(con, "all_review_data", review_data) - db_add_log(con) + db_add_log(con, "id") it("Can collect the desired data.", { output <- db_get_review(temp_path, subject = "Test_name", form = "Test_group") From c427f2dde6c634b60e9f65b78379a17ec9935cd1 Mon Sep 17 00:00:00 2001 From: Jeff Thompson <160783290+jthompson-arcus@users.noreply.github.com> Date: Mon, 18 Nov 2024 11:47:37 -0500 Subject: [PATCH 20/21] Resolve some R CMD check issues --- R/fct_SQLite.R | 2 ++ R/global.R | 3 ++- man/db_add_log.Rd | 5 ++++- 3 files changed, 8 insertions(+), 2 deletions(-) diff --git a/R/fct_SQLite.R b/R/fct_SQLite.R index eb3b366f..2509b914 100644 --- a/R/fct_SQLite.R +++ b/R/fct_SQLite.R @@ -156,6 +156,8 @@ db_add_primary_key <- function(con, name, value, keys = NULL) { #' all_review_data. #' #' @param con A DBI Connection to the SQLite DB +#' @param keys A character vector specifying which columns should not be updated +#' in a table. Default is ID and package defined index columns. #' #' @keywords internal db_add_log <- function(con, keys = c("id", idx_cols)) { diff --git a/R/global.R b/R/global.R index 68e661f1..645cd6f1 100644 --- a/R/global.R +++ b/R/global.R @@ -111,7 +111,8 @@ utils::globalVariables( "vis_day", "event_id", "region", - "suffix_names" + "suffix_names", + "form_type" ) ) diff --git a/man/db_add_log.Rd b/man/db_add_log.Rd index 77fb298f..fd85c1f4 100644 --- a/man/db_add_log.Rd +++ b/man/db_add_log.Rd @@ -4,10 +4,13 @@ \alias{db_add_log} \title{Add Logging Table} \usage{ -db_add_log(con) +db_add_log(con, keys = c("id", idx_cols)) } \arguments{ \item{con}{A DBI Connection to the SQLite DB} + +\item{keys}{A character vector specifying which columns should not be updated +in a table. Default is ID and package defined index columns.} } \description{ Both creates the logging table and the trigger to update it for From f57b549f8ec410bdedad1c82d02b06f1c4cf3cd5 Mon Sep 17 00:00:00 2001 From: LDSamson Date: Wed, 20 Nov 2024 12:12:39 +0100 Subject: [PATCH 21/21] Improve alignment according to https://style.tidyverse.org/syntax.html#long-function-calls, improve db_add_log docs, add function argument check to db_add_log --- R/fct_SQLite.R | 42 +++++++++++++++++++++++++++++++----------- man/db_add_log.Rd | 3 ++- 2 files changed, 33 insertions(+), 12 deletions(-) diff --git a/R/fct_SQLite.R b/R/fct_SQLite.R index 2509b914..54d78477 100644 --- a/R/fct_SQLite.R +++ b/R/fct_SQLite.R @@ -144,7 +144,11 @@ db_add_primary_key <- function(con, name, value, keys = NULL) { fields <- c(id = "INTEGER PRIMARY KEY AUTOINCREMENT", DBI::dbDataType(con, value)) DBI::dbCreateTable(con, name, fields) if (!is.null(keys)) { - rs <- DBI::dbSendStatement(con, sprintf("CREATE UNIQUE INDEX idx_%1$s ON %1$s (%2$s)", name, paste(keys, collapse = ", "))) + all_keys <- paste(keys, collapse = ", ") + rs <- DBI::dbSendStatement( + con, + sprintf("CREATE UNIQUE INDEX idx_%1$s ON %1$s (%2$s)", name, all_keys) + ) DBI::dbClearResult(rs) } DBI::dbAppendTable(con, name, value) @@ -154,25 +158,41 @@ db_add_primary_key <- function(con, name, value, keys = NULL) { #' #' Both creates the logging table and the trigger to update it for #' all_review_data. -#' +#' #' @param con A DBI Connection to the SQLite DB #' @param keys A character vector specifying which columns should not be updated -#' in a table. Default is ID and package defined index columns. -#' +#' in a table. Defaults to 'id' and the package-defined index columns +#' (`idx_cols`). +#' #' @keywords internal db_add_log <- function(con, keys = c("id", idx_cols)) { - DBI::dbCreateTable(con, "all_review_data_log", - c(id = "INTEGER PRIMARY KEY AUTOINCREMENT", review_id = "INTEGER NOT NULL", - edit_date_time = "CHAR", reviewed = "CHAR", comment = "CHAR", - reviewer = "CHAR", timestamp = "CHAR", status = "CHAR", - dml_type = "CHAR NOT NULL", dml_timestamp = "DATETIME DEFAULT CURRENT_TIMESTAMP")) + stopifnot(is.character(keys)) + all_keys <- paste(keys, collapse = ", ") + stopifnot("'keys' parameter cannot be empty" = nchar(all_keys) > 0) + + DBI::dbCreateTable( + con, + "all_review_data_log", + c( + id = "INTEGER PRIMARY KEY AUTOINCREMENT", + review_id = "INTEGER NOT NULL", + edit_date_time = "CHAR", + reviewed = "CHAR", + comment = "CHAR", + reviewer = "CHAR", + timestamp = "CHAR", + status = "CHAR", + dml_type = "CHAR NOT NULL", + dml_timestamp = "DATETIME DEFAULT CURRENT_TIMESTAMP" + ) + ) # This will trigger before any UPDATEs happen on all_review_data. Instead of # allowing 'id' to be updated, it will throw an error. rs <- DBI::dbSendStatement(con, paste( "CREATE TRIGGER all_review_data_id_update_trigger", - sprintf("BEFORE UPDATE OF %s ON all_review_data", paste(keys, collapse = ", ")), + sprintf("BEFORE UPDATE OF %s ON all_review_data", all_keys), "BEGIN", - sprintf("SELECT RAISE(FAIL, 'Fields %s are read only');", paste(keys, collapse = ", ")), + sprintf("SELECT RAISE(FAIL, 'Fields %s are read only');", all_keys), "END" )) DBI::dbClearResult(rs) diff --git a/man/db_add_log.Rd b/man/db_add_log.Rd index fd85c1f4..11a4457a 100644 --- a/man/db_add_log.Rd +++ b/man/db_add_log.Rd @@ -10,7 +10,8 @@ db_add_log(con, keys = c("id", idx_cols)) \item{con}{A DBI Connection to the SQLite DB} \item{keys}{A character vector specifying which columns should not be updated -in a table. Default is ID and package defined index columns.} +in a table. Defaults to 'id' and the package-defined index columns +(\code{idx_cols}).} } \description{ Both creates the logging table and the trigger to update it for