Merge pull request #146 from openpharma/jt-99-review_by_row_for_reals

Finally implement row review

DESCRIPTION

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

R/app_server.R

@@ -30,6 +30,9 @@ app_server <- function(
     })
   check_appdata(app_data, meta)
 
+  session$userData$review_records <- reactiveValues()
+  session$userData$update_checkboxes <- reactiveValues()
+
   res_auth <- authenticate_server(
     all_sites = app_vars$Sites$site_code, 
     credentials_db = credentials_db,

R/fct_data_helpers.R

@@ -516,7 +516,6 @@ add_missing_columns <- function(
 #' @param title Optional. Character string with the title of the table.
 #' @param selection See [DT::datatable()]. Default set to 'single'.
 #' @param extensions See [DT::datatable()]. Default set to 'Scroller'.
-#' @param plugins See [DT::datatable()]. Default set to 'scrollResize'.
 #' @param dom See \url{https://datatables.net/reference/option/dom}. A div
 #'   element will be inserted before the table for the table title. Default set
 #'   to 'fti' resulting in 'f<"header h5">ti'.
@@ -550,17 +549,18 @@ datatable_custom <- function(
     title = NULL, 
     selection = "single",
     extensions = c("Scroller", "ColReorder"),
-    plugins = "scrollResize",
     dom = "fti",
     options = list(),
     allow_listing_download = NULL,
     export_label = NULL,
     ...
     ){
   stopifnot(is.data.frame(data))
+  colnames <- names(data)
   if(!is.null(rename_vars)){
     stopifnot(is.character(rename_vars))
-    data <- dplyr::rename(data, dplyr::any_of(rename_vars))
+    colnames <- dplyr::rename(data[0,], dplyr::any_of(rename_vars)) |> 
+      names()
   }
   stopifnot(is.null(title) | is.character(title))
   stopifnot(grepl("t", dom, fixed = TRUE))
@@ -575,9 +575,12 @@ datatable_custom <- function(
     scrollX = TRUE,
     scroller = TRUE,
     deferRender = TRUE,
-    scrollResize = TRUE,
     scrollCollapse = TRUE,
-    colReorder = TRUE
+    colReorder = list(
+      enable = TRUE,
+      realtime = FALSE,
+      fixedColumnsLeft = 1
+    )
   )
   fixed_opts <- list(
     initComplete = DT::JS(
@@ -614,7 +617,7 @@ datatable_custom <- function(
     selection = selection,
     options = opts,
     extensions = extensions,
-    plugins = plugins,
+    colnames = colnames,
     ...
   ) 
 }

R/fct_form_helpers.R

@@ -0,0 +1,88 @@
+#' Update Review Records
+#'
+#' Updates the review records data frame when a datatable checkbox is clicked.
+#'
+#' @param review_records The review records data frame to update.
+#' @param review_selection The review selection data frame input from the
+#'   datatable.
+#' @param active_data The active review data frame.
+#' 
+#' @return A data frame containing the updated records data.
+#'
+#' @details Three main steps are performed: UPSERT, SUBSET, and ANTI-JOIN The
+#'   UPSERT takes the review selection data frame and upserts it into the review
+#'   records data frame. (An upsert will insert a record if the unique
+#'   identifier is not yet present and update a record based on the unique
+#'   identifier if it already exists.) The SUBSET step removes an empty reviews
+#'   (partially review rows) and any records not part of the active review (as a
+#'   precautionary measure). The ANTI-JOIN step removes any records that match
+#'   the active review (records that will not be changing review status based on
+#'   user inputs).
+#' 
+#' @noRd
+update_review_records <- function(review_records, review_selection, active_data) {
+  if (is.null(review_records))
+    review_records <- data.frame(id = integer(), reviewed = character())
+  review_records |> 
+    dplyr::rows_upsert(
+      review_selection,
+      by = "id"
+    ) |> 
+    # Remove empty reviews and inactive data IDs
+    subset(!is.na(reviewed) | !id %in% active_data$id) |> 
+    # Only update records where the review status is being changed
+    dplyr::anti_join(
+      active_data,
+      by = c("id", "reviewed")
+    ) |> 
+    dplyr::arrange(id)
+}
+
+#' Update Server Table from Selection
+#' 
+#' Updates the server table object based on the user selection.
+#' 
+#' @param tbl_data A data frame containing the server table.
+#' @param review_selection The review selection data frame input from the
+#'   datatable.
+#' 
+#' @return A data frame containing the updated table data.
+#' 
+#' @noRd
+update_tbl_data_from_datatable <- function(tbl_data, review_selection) {
+  update_row <- dplyr::distinct(review_selection, reviewed, row_id)
+  row_ids <- tbl_data$o_reviewed |> lapply(\(x) x[["row_id"]]) |> unlist()
+  tbl_data[row_ids == update_row$row_id, "o_reviewed"] <- list(list(
+    modifyList(tbl_data[row_ids == update_row$row_id,]$o_reviewed[[1]], 
+               list(updated = switch(update_row$reviewed, "Yes" = TRUE, "No" = FALSE, NA)))
+  ))
+  tbl_data
+}
+
+#' Overall Reviewed Field
+#'
+#' This field serves as the main communication mechanism between the Shiny
+#' session and the DataTable objects in the browser.
+#'
+#' @format A list with up to five elements:
+#' \describe{
+#'    \item{reviewed}{A logical indicating the current review status of the table row.}
+#'    \item{ids}{A vectors containing the `id`s associated with the table row.}
+#'    \item{row_id}{A numeric value indicating the associated row in the DataTable. (Used to update server data set based on user changes to browser table.)}
+#'    \item{disabled}{A logical indicating whether the table row is part of the active review.}
+#'    \item{updated}{A logical indicating whether the user has changed the review status in the DataTable.}
+#' }
+#'
+#' @details The first three elements, `reviewed`, `ids`, and `row_id`, are
+#'   initialized when the datatable data set is created (via `create_table()`
+#'   etc.). This occurs whenever there is a change with the review data. The
+#'   `disabled` element gets updated whenever there is a change in which subject
+#'   is actively being reviewed. The `updated` field gets changed in one of
+#'   three events: the subject being reviewed is changed and `updated` gets set
+#'   to `NULL`, a user changed review status in the DataTable object and
+#'   `updated` gets set to the user inputted value, and finally when a user
+#'   changes the overall review status in the sidebar and `updated` gets set to
+#'   reflect that inputted value.
+#' 
+#' @noRd
+# "o_reviewed"

R/fct_tables.R

@@ -51,19 +51,51 @@ create_table.default <- function(
   stopifnot(is.character(keep_vars))
   stopifnot(is.character(name_column))
   stopifnot(is.character(value_column))
+  if ("reviewed" %in% names(data)) {
+    data <- add_o_reviewed(data, keep_vars)
+    keep_vars <- c("o_reviewed", keep_vars)
+  }
   df <- data[c(keep_vars, name_column, value_column)] |> 
     tidyr::pivot_wider(
       names_from = {{name_column}}, 
       values_from = {{value_column}}, 
       values_fn = ~paste0(., collapse = "; ")
-      ) 
+      )
   expected_columns <- na.omit(expected_columns) %||% character(0)
   if(length(expected_columns) == 0) return(df)
   add_missing_columns(df, expected_columns)[
     unique(c(keep_vars, expected_columns))
     ]
 }
 
+#' Add Overall Reviewed Field
+#'
+#' Adds a field to the data set summarizing the overall review status over the
+#' rows uniquely defined by the ID columns.
+#'
+#' @param data A data frame to mutate
+#' @param id_cols A set of columns that uniquely identify each observation
+#'
+#' @details This function servers as a helper to `create_table.default()`. If
+#' the field `reviewed` is contained in the data frame, an overall review status
+#' field will be added to the data frame. The field is a list consistent of two
+#' named elements: `reviewed` and `ids`. The `reviewed` field is `TRUE` if all
+#' records are reviewed, `FALSE` if all records are not reviewed, and `NA` if
+#' some records are reviewed and some are not. The `ids` field contains a vector
+#' of the IDs associated with the unique observation defined by `id_cols`.
+#' 
+#' @noRd
+add_o_reviewed <- function(data, id_cols) {
+  dplyr::mutate(
+    data,
+    o_reviewed = dplyr::case_when(
+      any(reviewed == "No") & any(reviewed == "Yes") ~ list(list(reviewed = NA, ids = id)),
+      any(reviewed == "Yes") ~ list(list(reviewed = TRUE, ids = id)),
+      .default = list(list(reviewed = FALSE, ids = id))
+    ),
+    .by = dplyr::all_of(id_cols))
+}
+
 
 #' Create Table with continuous data.
 #'
@@ -227,7 +259,7 @@ create_table.adverse_events <- function(
                              keep_vars, expected_columns) |> 
     adjust_colnames("^AE ") 
   df[["Number"]] <- NULL
-
+  
   # create new row when an AE gets worse:
   df_worsening <- df[!is.na(df[[worsening_start_column]]), ] |> 
     dplyr::mutate(
@@ -298,6 +330,7 @@ create_table.medication <- function(
     ) |> 
     dplyr::arrange(dplyr::desc(in_use), dplyr::desc(`Start Date`)) |> 
     dplyr::select(
+      dplyr::any_of("o_reviewed"),
       dplyr::all_of(c(keep_vars, "Name")), 
       dplyr::everything(),
       -dplyr::all_of(c("in_use", "Active Ingredient", "Trade Name", 

R/global.R

@@ -112,7 +112,10 @@ utils::globalVariables(
     "event_id",
     "region",
     "suffix_names",
-    "form_type"
+    "form_type",
+    "id",
+    "o_reviewed",
+    "row_id"
   )
 )
 

R/mod_common_forms.R

@@ -11,9 +11,9 @@ mod_common_forms_ui <- function(id, form){
     bslib::layout_sidebar(
       fillable = FALSE,
       if(form == "Adverse events"){
-        DT::dataTableOutput(ns("SAE_table"))
+        mod_review_form_tbl_ui(ns("review_form_SAE_tbl"))
       },
-      DT::dataTableOutput(ns("common_form_table")), 
+      mod_review_form_tbl_ui(ns("review_form_tbl")),
       sidebar = bslib::sidebar(
         bg = "white", 
         position = "right",
@@ -73,7 +73,8 @@ mod_common_forms_ui <- function(id, form){
 #'   interactive tables.
 #'
 #' @seealso [mod_common_forms_ui()], [mod_timeline_ui()],
-#'   [mod_timeline_server()]
+#'   [mod_timeline_server()], [mod_review_form_tbl_ui()],
+#'   [mod_review_form_tbl_server()]
 #' 
 mod_common_forms_server <- function(
     id, 
@@ -93,81 +94,62 @@ mod_common_forms_server <- function(
   moduleServer( id, function(input, output, session){
     ns <- session$ns
 
-    data_active <- reactive({
-      shiny::validate(need(
-        !is.null(r$filtered_data[[form]]),
-        paste0("Warning: no data found in the database for the form '", form, "'.")
-      ))
-      df <- dplyr::left_join(
-        r$filtered_data[[form]],
-        with(r$review_data, r$review_data[item_group == form, ]) |> 
-          dplyr::select(-dplyr::all_of(c("edit_date_time", "event_date"))), 
-        by = id_item
-      ) |> 
-        dplyr::mutate(
-          item_value = ifelse(
-            reviewed == "No", 
-            paste0("<b>", htmltools::htmlEscape(item_value), "*</b>"), 
-            htmltools::htmlEscape(item_value)
-          )
+    common_form_data <- reactiveVal()
+    SAE_data <- reactiveVal()
+    observe({
+      df <- {
+        shiny::validate(need(
+          !is.null(r$filtered_data[[form]]),
+          paste0("Warning: no data found in the database for the form '", form, "'.")
+        ))
+        dplyr::left_join(
+          r$filtered_data[[form]],
+          with(r$review_data, r$review_data[item_group == form, ]) |> 
+            dplyr::select(-dplyr::all_of(c("edit_date_time", "event_date"))), 
+          by = id_item
         ) |> 
-        create_table(expected_columns = names(form_items))
-      if(!input$show_all_data){ 
-        df <-  with(df, df[subject_id == r$subject_id, ]) 
+          dplyr::mutate(
+            item_value = ifelse(
+              reviewed == "No", 
+              paste0("<b>", htmltools::htmlEscape(item_value), "*</b>"), 
+              htmltools::htmlEscape(item_value)
+            )
+          ) |> 
+          create_table(expected_columns = names(form_items)) |> 
+          dplyr::mutate(o_reviewed = Map(\(x, y, z) append(x, list(row_id = y, disabled = z)), 
+                                         o_reviewed, 
+                                         dplyr::row_number(),
+                                         subject_id != r$subject_id))
       }
-      df
+      common_form_data({
+        if(form == "Adverse events") {
+          df |> 
+            dplyr::filter(!grepl("Yes", `Serious Adverse Event`)
+            ) |> 
+            dplyr::select(-dplyr::starts_with("SAE"))
+        } else {
+          df
+        }
+      })
+      if (form == "Adverse events")
+        SAE_data({
+          df |>
+            dplyr::filter(grepl("Yes", `Serious Adverse Event`)) |>
+            dplyr::select(dplyr::any_of(
+              c("o_reviewed", "subject_id","form_repeat", "Name", "AESI",  "SAE Start date",
+                "SAE End date", "CTCAE severity", "Treatment related",
+                "Treatment action", "Other action", "SAE Category",
+                "SAE Awareness date", "SAE Date of death", "SAE Death reason")
+            )) |>
+            adjust_colnames("^SAE ")
+        })
     })
+    mod_review_form_tbl_server("review_form_tbl", r, common_form_data, form, reactive(input$show_all_data), table_names, form)
+    if (form == "Adverse events")
+      mod_review_form_tbl_server("review_form_SAE_tbl", r, SAE_data, form, reactive(input$show_all_data), table_names, "Serious Adverse Events")
 
     mod_timeline_server("timeline_fig", r = r, form = form)
 
-    output[["SAE_table"]] <- DT::renderDT({
-      req(form == "Adverse events")
-      SAE_data <- data_active() |> 
-        dplyr::filter(grepl("Yes", `Serious Adverse Event`)) |> 
-        dplyr::select(dplyr::any_of(
-          c("subject_id","form_repeat", "Name", "AESI",  "SAE Start date", 
-            "SAE End date", "CTCAE severity", "Treatment related", 
-            "Treatment action", "Other action", "SAE Category", 
-            "SAE Awareness date", "SAE Date of death", "SAE Death reason")
-        )) |> 
-        adjust_colnames("^SAE ")
-      if(!input$show_all_data) SAE_data$subject_id <- NULL
-
-      datatable_custom(
-        SAE_data, rename_vars = table_names, rownames= FALSE,
-        title = "Serious Adverse Events", escape = FALSE,
-        export_label = paste(
-          "SAE", 
-          ifelse(input$show_all_data, "all_patients", r$subject_id), 
-          sep = "."
-          )
-        ) 
-    })
-
-    output[["common_form_table"]] <- DT::renderDT({
-      df <- data_active()
-      if(form == "Adverse events") {
-        df <- df |> 
-          dplyr::filter(!grepl("Yes", `Serious Adverse Event`)
-          ) |> 
-          dplyr::select(-dplyr::starts_with("SAE"))
-      }
-      if(!input$show_all_data) df$subject_id <- NULL
-
-      datatable_custom(
-        df, 
-        rename_vars = table_names, 
-        rownames= FALSE, 
-        title = form, 
-        escape = FALSE, 
-        export_label = paste(
-          simplify_string(form), 
-          ifelse(input$show_all_data, "all_patients", r$subject_id), 
-          sep = "."
-          )
-      )
-    })
-
   })
 }