Merge pull request #135 from openpharma/jt-113-simplify_review_process

Simplify review process

.gitignore

@@ -2,6 +2,7 @@
 .Rhistory
 .RData
 .Ruserdata
+.Renviron
 *.html
 *.tmp
 ~$*

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: clinsight
 Title: ClinSight
-Version: 0.1.1.9008
+Version: 0.1.0.9009
 Authors@R: c(
     person("Leonard Daniël", "Samson", , "[email protected]", role = c("cre", "aut"),
            comment = c(ORCID = "0000-0002-6252-7639")),

NEWS.md

@@ -8,6 +8,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
 

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,

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,16 +158,44 @@ 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. Defaults to 'id' and the package-defined index columns
+#'   (`idx_cols`).
+#'
 #' @keywords internal
-db_add_log <- function(con) {
-  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"))
+db_add_log <- function(con, keys = c("id", idx_cols)) {
+  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", all_keys),
+    "BEGIN",
+    sprintf("SELECT RAISE(FAIL, 'Fields %s are read only');", all_keys),
+    "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",
@@ -292,7 +324,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
@@ -306,8 +337,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))
@@ -331,10 +360,7 @@ db_save_review <- function(
     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)) |> 
     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")
@@ -497,6 +523,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)

R/fct_db_collect_data.R

@@ -82,6 +82,16 @@ 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)
+  sql <- "SELECT * FROM ?db_table"
+  query <- DBI::sqlInterpolate(con, sql, db_table = db_table[1])
+  DBI::dbGetQuery(con, query)
+}
+
 
 #' Collect query data
 #'

R/global.R

@@ -111,7 +111,8 @@ utils::globalVariables(
     "vis_day",
     "event_id",
     "region",
-    "suffix_names"
+    "suffix_names",
+    "form_type"
   )
 )
 

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 
 } 

R/mod_review_forms.R

@@ -294,7 +294,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") 

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 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"))){
       db_update(get_review_data(data), db_path = user_db) 

inst/golem-config.yml

@@ -1,6 +1,6 @@
 default:
   golem_name: clinsight
-  golem_version: 0.1.1.9008
+  golem_version: 0.1.0.9009
   app_prod: no
   user_identification: test_user
   study_data: !expr clinsight::clinsightful_data

tests/testthat/_snaps/mod_review_forms.md

@@ -1,50 +1,42 @@
 # 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: 4 x 12
-           id subject_id event_name item_group     form_repeat item_name              
-        <int> <chr>      <chr>      <chr>                <dbl> <chr>                  
-      1     3 361        Visit 5    Vital signs              4 Systolic blood pressure
-      2     4 361        Visit 6    Vital signs              5 Systolic blood pressure
-      3     1 885        Any visit  Adverse events           1 Atrial Fibrillation    
-      4     2 885        Any visit  Adverse events           2 Cystitis               
-        event_date edit_date_time      reviewed comment          
-        <chr>      <chr>               <chr>    <chr>            
-      1 2023-07-01 2023-08-30 01:01:01 Yes      "another comment"
-      2 2023-08-01 2023-08-02 01:01:01 No       ""               
-      3 2023-08-15 2023-09-30 01:01:01 Yes      "test comment"   
-      4 2023-09-01 2023-10-01 01:01:01 Yes      ""               
-        reviewer                      status
-        <chr>                         <chr> 
-      1 "Reviewer 2"                  old   
-      2 ""                            new   
-      3 "Reviewer 1"                  old   
-      4 "test_name (Medical Monitor)" old   
+        id subject_id event_name     item_group form_repeat               item_name
+      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
 
 ---
 
     Code
-      print(dplyr::select(r$review_data, -timestamp), width = Inf)
+      dplyr::select(r$review_data, -timestamp)
     Output
-      # A tibble: 4 x 12
-           id subject_id event_name item_group     form_repeat item_name              
-        <int> <chr>      <chr>      <chr>                <dbl> <chr>                  
-      1     3 361        Visit 5    Vital signs              4 Systolic blood pressure
-      2     4 361        Visit 6    Vital signs              5 Systolic blood pressure
-      3     1 885        Any visit  Adverse events           1 Atrial Fibrillation    
-      4     2 885        Any visit  Adverse events           2 Cystitis               
-        event_date edit_date_time      reviewed comment          
-        <chr>      <chr>               <chr>    <chr>            
-      1 2023-07-01 2023-08-30 01:01:01 Yes      "another comment"
-      2 2023-08-01 2023-08-02 01:01:01 No       ""               
-      3 2023-08-15 2023-09-30 01:01:01 No       "test review"    
-      4 2023-09-01 2023-10-01 01:01:01 No       "test review"    
-        reviewer                      status
-        <chr>                         <chr> 
-      1 "Reviewer 2"                  old   
-      2 ""                            new   
-      3 "test_name (Medical Monitor)" new   
-      4 "test_name (Medical Monitor)" new   
+        id subject_id event_name     item_group form_repeat               item_name
+      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 test_name (Medical Monitor)    new
+      3                  Reviewer 2    old
+      4                                new
 

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)
 })

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")