Review by records instead of subject_id & form_id "rv_row"

DESCRIPTION

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

NEWS.md

@@ -9,6 +9,7 @@
 - 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.
+- Review data by records IDs instead of subject & form
 
 ## Bug fixes
 

R/fct_SQLite.R

@@ -319,51 +319,35 @@ db_upsert <- function(con, data, idx_cols) {
 #' New rows with the new/updated review data will be added to the applicable
 #' database tables.
 #'
-#' @param rv_row A data frame containing the row of the data that needs to be
+#' @param rv_records A data frame containing the rows of data that needs to be
 #'   checked.
 #' @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 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
-#'   different review per item.
 #'
 #' @return Review information will be written in the database. No local objects
 #'   will be returned.
 #' @export
 #' 
 db_save_review <- function(
-    rv_row,
+    rv_records,
     db_path,
-    tables = c("all_review_data"),
-    review_by = c("subject_id", "item_group")
+    tables = c("all_review_data")
 ){
-  stopifnot(is.data.frame(rv_row))
-  if(nrow(rv_row) != 1){
-    warning("multiple rows detected to save in database. Only the first row will be selected.")
-    rv_row <- rv_row[1, ]
+  stopifnot(is.data.frame(rv_records))
+  if (any(duplicated(rv_records[["id"]]))) {
+    warning("duplicate records detected to save in database. Only the first will be selected.")
+    rv_records[!duplicated(rv_records[["id"]]),]
   }
-  
+
   cols_to_change <- c("reviewed", "comment", "reviewer", "timestamp", "status")
   db_con <- get_db_connection(db_path)
-  new_review_state <- rv_row$reviewed
-  cat("copy row ids into database\n ")
-  dplyr::copy_to(db_con, rv_row[review_by], "row_ids")
-  new_review_rows <-  dplyr::tbl(db_con, "all_review_data") |> 
-    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(
+  if(nrow(rv_records) == 0){return(
     warning("Review state unaltered. No review will be saved.")
   )}
-  new_review_rows <- new_review_rows |> 
-    dplyr::select(-dplyr::all_of(cols_to_change)) |> 
-    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")
+  dplyr::copy_to(db_con, rv_records, "row_updates")
   rs <- DBI::dbSendStatement(db_con, paste(
     "UPDATE",
     tables,
@@ -372,7 +356,9 @@ db_save_review <- function(
     "FROM",
     "row_updates",
     "WHERE",
-    sprintf("%s.id = row_updates.id", tables)
+    sprintf("%s.id = row_updates.id", tables),
+    "AND",
+    sprintf("%s.reviewed <> row_updates.reviewed", tables)
   ))
   DBI::dbClearResult(rs)
   cat("finished writing to the tables:", tables, "\n")
@@ -473,12 +459,12 @@ db_get_query <- function(
 #' with the given subject id (`subject`) and `form`.
 #'
 #' @param db_path Character vector. Needs to be a valid path to a database.
-#' @param subject Character vector with the subject identifier to select from
-#'   the database.
-#' @param form Character vector with the form identifier to select from the
-#'   database.
+#' @param ... Named arguments specifying which records to retrieve, see
+#'   examples. Note that `...` will be processed with `data.frame()` since
+#'   parameters must have equal length.
+#' @param db_table Character string. Name of the table to collect. Will only be
+#'   used if `data` is a character string to a database.
 #'
-#' @inheritParams db_slice_rows
 #' @return A data frame.
 #' @export
 #'
@@ -488,38 +474,38 @@ db_get_query <- function(
 #'   temp_path <- withr::local_tempfile(fileext = ".sqlite")
 #'   con <- get_db_connection(temp_path)
 #'   review_data <- data.frame(
-#'   subject_id = "Test_name",
-#'    event_name = "Visit 1",
-#'    item_group = "Test_group",
-#'    form_repeat = 1,
-#'    item_name = "Test_item",
-#'    edit_date_time = "2023-11-05 01:26:00",
-#'    timestamp = "2024-02-05 01:01:01"
+#'    subject_id = c("Test_name", "Test_name2"),
+#'    id = 1:2,
+#'    event_name = c("Visit 1", "Visit 1"),
+#'    item_group = c("Test_group", "Test_group2"),
+#'    form_repeat = c(1, 1),
+#'    item_name = c("Test_item", "Test_item2"),
+#'    edit_date_time = rep("2023-11-05 01:26:00", 2),
+#'    timestamp = rep("2024-02-05 01:01:01", 2)
 #'   ) |>
 #'    dplyr::as_tibble()
 #'   DBI::dbWriteTable(con, "all_review_data", review_data)
-#'   db_get_review(temp_path, subject = "Test_name", form = "Test_group")
+#'   db_get_review(temp_path, id = 1L)
+#'   db_get_review(temp_path, subject_id = "Test_name2")
 #' })
 #' 
 db_get_review <- function(
     db_path, 
-    subject = review_row$subject_id, 
-    form = review_row$item_group,
-    db_table = "all_review_data",
-    slice_vars = c("timestamp", "edit_date_time"),
-    group_vars = c("subject_id", "event_name", "item_group",
-                   "form_repeat", "item_name")
+    ...,
+    db_table = "all_review_data"
 ){
   stopifnot(file.exists(db_path))
-  stopifnot(is.character(subject))
-  stopifnot(is.character(form))
   db_temp_connect(db_path, {
-    sql <- "SELECT * FROM ?db_table WHERE subject_id = ?id AND item_group = ?group;"
-    query <- DBI::sqlInterpolate(con, sql, db_table = db_table[1], 
-                                 id = subject[1], group = form[1])
-    DBI::dbGetQuery(con, query) |> 
-      db_slice_rows(slice_vars = slice_vars, group_vars = group_vars) |> 
+    fields <- ...names()
+    sql <- paste("SELECT * FROM ?db_table WHERE", paste0(fields, " = $", fields, collapse = " AND "))
+    query <- DBI::sqlInterpolate(con, sql, db_table = db_table[1])
+    rs <- DBI::dbSendQuery(con, query)
+    DBI::dbBind(rs, params = data.frame(...))
+    df <- 
+      DBI::dbFetch(rs) |> 
       dplyr::as_tibble()
+    DBI::dbClearResult(rs)
+    df
   })
 }
 

R/mod_review_forms.R

@@ -110,14 +110,10 @@ mod_review_forms_server <- function(
     ns <- session$ns
 
     review_data_active <- reactive({
-      df <- r$review_data |>
+      r$review_data |>
         dplyr::filter(subject_id == r$subject_id, 
                       item_group == active_form()) |> 
-        dplyr::distinct(subject_id, item_group, edit_date_time, reviewed, comment, status)
-      #!! below selects the latest edit_date_time; usually only one row will remain by then since there are no items displayed here.
-      if(nrow(df)== 0) return(df)
-      df |> 
-        dplyr::filter(edit_date_time == max(as.POSIXct(edit_date_time)))
+        dplyr::select(id, dplyr::all_of(idx_cols), edit_date_time, reviewed, comment, status)
     }) 
 
     observeEvent(c(active_form(), r$subject_id), {
@@ -136,8 +132,8 @@ mod_review_forms_server <- function(
         # it will give a warning. This would be rare since it would mean a datapoint with the same edit date-time was reviewed but another one was not. 
         # probably better to use defensive coding here to ensure the app does not crash in that case. However we need to define which review status we need to select
         # in this case get the reviewed = "No"
-        review_status  <- unique(review_data_active()$reviewed)
-        review_comment <- unique(review_data_active()$comment)
+        review_status <- with(review_data_active(), reviewed[edit_date_time == max(as.POSIXct(edit_date_time))]) |> unique()
+        review_comment <- with(review_data_active(), comment[edit_date_time == max(as.POSIXct(edit_date_time))]) |> unique()
         if(length(review_status) != 1) warning("multiple variables in review_status, namely: ", 
                                                review_status, "Verify data.")
       }
@@ -191,8 +187,8 @@ mod_review_forms_server <- function(
         ) 
       if(!enable_any_review()) return(FALSE)
       any(c(
-        unique(review_data_active()$reviewed) == "No"  & input$form_reviewed, 
-        unique(review_data_active()$reviewed) == "Yes" & !input$form_reviewed
+        unique(with(review_data_active(), reviewed[edit_date_time == max(as.POSIXct(edit_date_time))])) == "No"  & input$form_reviewed, 
+        unique(with(review_data_active(), reviewed[edit_date_time == max(as.POSIXct(edit_date_time))])) == "Yes" & !input$form_reviewed
       ))
     })
 
@@ -231,8 +227,8 @@ mod_review_forms_server <- function(
       review_save_error(FALSE)
       golem::cat_dev("Save review status reviewed:", input$form_reviewed, "\n")
 
-      review_row <- review_data_active() |> 
-        dplyr::distinct(subject_id, item_group) |> 
+      review_records <- review_data_active() |> 
+        dplyr::distinct(id) |>
         dplyr::mutate(
           reviewed    = if(input$form_reviewed) "Yes" else "No",
           comment     = ifelse(is.null(input$review_comment), "", input$review_comment),
@@ -242,45 +238,40 @@ mod_review_forms_server <- function(
         ) 
 
       golem::cat_dev("review row to add:\n")
-      golem::print_dev(review_row)
+      golem::print_dev(review_records)
 
       cat("write review progress to database\n")
       db_save_review(
-        review_row, 
+        review_records, 
         db_path = db_path,
         # More tables can be added here if needed, to track process of 
         # individual reviewers in individual tables:
         tables = "all_review_data" 
       )
 
-      # Contains multiple rows, one for each item.
       updated_rows_db <- db_get_review(
-        db_path, subject = review_row$subject_id, form = review_row$item_group
-        )[c(names(review_row), "event_name", "item_name", "form_repeat")]
-      # Within a form, only items with a changed review state are updated and 
-      # contain the new (current) time stamp. 
-      updated_rows_db <- updated_rows_db[
-        updated_rows_db$timestamp == review_row$timestamp[1], 
-        ]
+        db_path, id = review_records$id
+        ) |> 
+        dplyr::select(dplyr::all_of(names(review_records)))
 
-      review_row_db <- unique(updated_rows_db[names(review_row)])
-      if(identical(review_row_db, review_row)){
+      review_records_db <- updated_rows_db |> 
+        # Within a form, only items with a changed review state are updated and 
+        # contain the new (current) time stamp. 
+        dplyr::filter(timestamp == review_records$timestamp[1])
+      if(isTRUE(all.equal(review_records_db, review_records, check.attributes = FALSE))){
         cat("Update review data and status in app\n")
         r$review_data <- r$review_data |> 
-          dplyr::rows_update(
-            updated_rows_db, 
-            by = c("subject_id", "item_group", "event_name", "item_name", "form_repeat")
-          )
+          dplyr::rows_update(review_records, by = "id")
       }
 
-      updated_items_memory <- sort(with(r$review_data, item_name[
-        reviewer == review_row$reviewer[1] & timestamp == review_row$timestamp[1]
-      ]))
-      updated_items_db <- sort(updated_rows_db$item_name)
+      updated_items_memory <- review_records |> 
+        dplyr::left_join(r$review_data, by = "id", suffix = c("", ".y")) |> 
+        dplyr::select(dplyr::all_of(names(review_records))) |> 
+        dplyr::filter(timestamp == review_records$timestamp[1])
 
       review_save_error(any(
-        !identical(review_row_db, review_row),
-        !identical(updated_items_db, updated_items_memory)
+        !isTRUE(all.equal(review_records_db, review_records, check.attributes = FALSE)),
+        !isTRUE(all.equal(updated_items_memory, review_records_db, check.attributes = FALSE))
       ))
 
       if(review_save_error()){
@@ -320,7 +311,7 @@ mod_review_forms_server <- function(
         "No user name found. Cannot save review"
       ))
       validate(need(
-        !review_data_active()$reviewed == "Yes",
+        !unique(with(review_data_active(), reviewed[edit_date_time == max(as.POSIXct(edit_date_time))])) == "Yes",
         "Form already reviewed"
       ))
       validate(need(input$form_reviewed, "Requires review"))

inst/golem-config.yml

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