diff --git a/DESCRIPTION b/DESCRIPTION index ee20923f..a454df45 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,12 +1,12 @@ Package: clinsight Title: ClinSight -Version: 0.3.0 +Version: 0.4.0 Authors@R: c( person("Leonard DaniĆ«l", "Samson", , "lsamson@gcp-service.com", role = c("cre", "aut"), comment = c(ORCID = "0000-0002-6252-7639")), - person("Aaron", "Clark", , "aclark02@arcusbio.com", role = "ctb", + person("Aaron", "Clark", , "aclark02@arcusbio.com", role = "aut", comment = c(ORCID = "0000-0002-0123-0970")), - person("Jeff", "Thompson", , "jthompson@arcusbio.com", role = "ctb", + person("Jeff", "Thompson", , "jthompson@arcusbio.com", role = "aut", comment = c(ORCID = "0009-0007-3640-1075")), person("GCP-Service International Ltd.& Co. KG", role = "fnd") ) @@ -49,6 +49,7 @@ Imports: Suggests: base64enc, chromote, + jsonlite, kableExtra, knitr, pkgload, diff --git a/NEWS.md b/NEWS.md index 2ca9435b..868c804b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,37 @@ +# clinsight 0.4.0 + +## Changed + +- Implemented a `line-clamp` on table column names that wrap to more than 6 lines (#253). +- Added a toggle to switch data transformation (#110, #261). +- Added functionality to show data transformed to standard values so that all are shown in the same unit (#110, #261). +- Figures now also show patient-specific lab limits in the figures when data is not transformed (if available) (#249). +- Improved the time-series on-hover label so that limits and significance are also shown (#249). +- Added a toggle to enable/disable background patterns in figures (#249). +- Added a toggle to enable hover labels of background patterns in the figures (#249). +- Added additional navigation buttons next to more easily navigate between between common forms and study forms (#255). +- Added a toggle to enable text wrapping in tables (#252). +- Added a toggle to show laboratory limits in the tables (#110). +- The timeline is now available in all forms and can be toggled on or off (#258). +- Visually updated table and figure switches to native `bslib` switches and added icons to them (#268). + +## Bug fixes + +- [fix_multiple_choice_vars()] now also fixes long-format multiple choice variables that end with a number (#247). +- Added date origin to `as.Date()` in `get_timeline_data()` that Posit Connect couldn't handle without (#269). +- Switched to server-side table downloads to ensure that always all data is included in the table (#240, #241, #250). +- Data from before baseline events (which is counted as day zero) are now also shown in figures. Now the baseline event can for example be set on the first treatment day, and the screening data will show as a negative day in the figures (#242). + +## Developer notes + +- Updated role of long-term contributors to co-authors in Description field (#246). +- Refactored some functions so that it is no longer needed to create an `apptables` object when starting the application, improving start up efficiency (#251). +- Refactored function to retrieve summary data to improve efficiency (#263). +- Replaced `dplyr::case_when()` with `ifelse()` in the row review status calculation for efficiency (#243). +- `ClinSight` now also looks for a `clinsight-config.yml` file in the current working directory and uses it as custom configuration (#256). +- Added better control of role privileges - `allowed_to_review` and `allowed_to_query` can now be set per role in the `config.yml` file (#17, #256). +- Several test snapshots are now much smaller, with better focus on the feature being tested so that they are easier to maintain (#259). + # clinsight 0.3.0 ## Developer notes diff --git a/R/app_server.R b/R/app_server.R index 5ccd6406..29bc3b55 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -25,10 +25,6 @@ app_server <- function( app_data <- get_appdata(merged_data, meta = meta) app_vars <- get_meta_vars(data = app_data, meta = meta) - app_tables <- lapply( - setNames(names(app_data), names(app_data)), \(x){ - create_table(app_data[[x]], expected_columns = names(app_vars$items[[x]])) - }) check_appdata(app_data, meta) session$userData$pending_review_records <- reactiveValues() @@ -45,8 +41,6 @@ app_server <- function( # For query item selector drop-down menus: available_data <- get_available_data( data = app_data, - tables = app_tables, - all_forms = app_vars$all_forms, form_repeat_name = with( meta[["table_names"]], table_name[raw_name == "form_repeat"] @@ -57,17 +51,25 @@ app_server <- function( # For summary review data: static_overview_data <- get_static_overview_data( data = app_data, + available_data = available_data, expected_general_columns = unique( with(meta$items_expanded, item_name[item_group == "General"]) ) ) + + # For timeline data + timeline_data <-get_timeline_data( + app_data, + available_data = available_data, + treatment_label = meta$settings$treatment_label %||% "\U1F48A T\U2093" + ) + # think of using the pool package, but functions such as row_update are not yet supported. r <- reactiveValues( review_data = do.call(reactiveValues, split_review_data(user_db, forms = app_vars$all_forms$form)), query_data = collect_query_data(user_db), filtered_subjects = app_vars$subject_id, filtered_data = app_data, - filtered_tables = app_tables, subject_id = app_vars$subject_id[1] ) @@ -84,27 +86,25 @@ app_server <- function( user_error("No valid user name provided. ") } if(r$user_role == ""){ - user_error(paste0(user_error(), "No valid user role provided. ")) + user_error(paste0(user_error(), "No user role assigned. ")) } if(!is.null(user_error())){ user_error( paste0( user_error(), "Functionality is limited. ", - "Please contact the administrator to resolve this issue." + "If this is unexpected, please contact the administrator." ) ) } }) - forms_to_review_data <- app_vars$form_level_data[c("item_group", "review_required")] - observeEvent(user_error(), { showNotification( user_error(), id = "user_error", - type = "error", - duration = NULL + type = "warning", + duration = 5 ) }) @@ -116,34 +116,30 @@ app_server <- function( observeEvent(rev_sites(), { req(!all(rev_sites() %in% app_vars$Sites$site_code)) r <- filter_data(r, rev_sites(), subject_ids = app_vars$subject_id, - appdata = app_data, apptables = app_tables) + appdata = app_data) }) navinfo <- reactiveValues( active_form = app_vars$all_forms$form[1], active_tab = "Start", - trigger_page_change = 1 + trigger_page_change = 1, + cf_toggle_timeline = reactive({input$cf_toggle_timeline}), + sf_toggle_timeline = reactive({input$sf_toggle_timeline}) ) + start_page_summary_vars <- c("subject_status", "WHO.classification", "Age", "Sex", "event_name") + forms_to_review <- with(app_vars$form_level_data, item_group[review_required]) rev_data <- reactiveValues( summary = reactive({ - req(forms_to_review_data) - r$review_data |> - reactiveValuesToList() |> - do.call(what = rbind) |> - dplyr::left_join(forms_to_review_data, by = "item_group") |> - dplyr::filter( - reviewed != "Yes", - review_required, - subject_id %in% r$filtered_subjects - ) |> - summarize_review_data() |> - dplyr::select(subject_id, "Form" = item_group, "Event" = event_name, - "Edit date" = edit_date_time, status, reviewed) + req(forms_to_review) + reactiveValuesToList(r$review_data)[forms_to_review] |> + dplyr::bind_rows() |> + subset(reviewed != "Yes" & subject_id %in% r$filtered_subjects) |> + summarize_review_data() }), overview = reactive({ - static_overview_data |> - dplyr::filter(subject_id %in% r$filtered_subjects) |> + with(static_overview_data, static_overview_data[subject_id %in% r$filtered_subjects, ]) |> + dplyr::select(tidyr::all_of("subject_id"), tidyr::any_of(start_page_summary_vars)) |> dplyr::mutate( needs_review = subject_id %in% unique(rev_data$summary()$subject_id) ) |> @@ -206,14 +202,6 @@ app_server <- function( identical(session$userData$review_type(), "form") }) outputOptions(output, "form_level_review", suspendWhenHidden = FALSE) - - timeline_data <- reactive({ - get_timeline_data( - r$filtered_data, - r$filtered_tables, - treatment_label = meta$settings$treatment_label %||% "\U1F48A T\U2093" - ) - }) ###### Load common form tabs in UI and server: common_forms <- with(app_vars$all_forms, form[main_tab == "Common events"]) @@ -224,6 +212,10 @@ app_server <- function( select = (i == common_forms[1]) ) }) + bslib::nav_insert( + id = "common_data_tabs", + nav = bslib::nav_item(actionLink("go_to_study_data", ">", class="nav-link px-3")) + ) lapply(common_forms, \(x){ mod_common_forms_server( id = paste0("cf_", simplify_string(x)), @@ -232,14 +224,17 @@ app_server <- function( form_review_data = reactive(r$review_data[[x]]), form_items = app_vars$items[[x]], active_subject = reactive(r$subject_id), - table_names = app_vars$table_names, - timeline_data = timeline_data + table_names = app_vars$table_names ) }) |> unlist(recursive = FALSE) ###### Load study form tabs in UI and server: study_forms <- with(app_vars$all_forms, form[main_tab == "Study data"]) + bslib::nav_insert( + id = "study_data_tabs", + nav = bslib::nav_item(actionLink("go_to_common_events", "<", class="nav-link px-3")) + ) lapply(study_forms, \(i){ bslib::nav_insert( id = "study_data_tabs", @@ -248,6 +243,7 @@ app_server <- function( select = (i == study_forms[1]) ) }) + lapply(study_forms, \(x){ mod_study_forms_server( id = paste0("sf_", simplify_string(x)), @@ -262,16 +258,59 @@ app_server <- function( }) |> unlist(recursive = FALSE) + bslib::nav_insert( + id = "common_data_tabs", + bslib::nav_item( + class = "ms-auto mb-0", + bslib::input_switch( + id = "cf_toggle_timeline", + label = span(icon("timeline"), "Timeline"), + value = TRUE, + width = "auto" + ) |> + htmltools::tagAppendAttributes(class = "mb-0") + ) + ) + + bslib::nav_insert( + id = "study_data_tabs", + bslib::nav_item( + class = "ms-auto", + bslib::input_switch( + id = "sf_toggle_timeline", + label = span(icon("timeline"), "Timeline"), + value = FALSE, + width = "auto" + ) |> + htmltools::tagAppendAttributes(class = "mb-0") + ) + ) + + observeEvent(session$userData$review_type(), { + subject_level_review <- identical(session$userData$review_type(), "subject") + shinyjs::toggleElement("cf_toggle_timeline", subject_level_review) + shinyjs::toggleElement("sf_toggle_timeline", subject_level_review) + }) + + + observeEvent(input$go_to_study_data, { + bslib::nav_select(id = "main_tabs", selected = "Study data") + }) + observeEvent(input$go_to_common_events, { + bslib::nav_select(id = "main_tabs", selected = "Common events") + }) + mod_start_page_server("start_page_1", r, rev_data, navinfo, app_vars$all_forms, app_vars$table_names) mod_header_widgets_server( id = "header_widgets_1", r = r, rev_data = rev_data, - navinfo = navinfo + navinfo = navinfo, + timeline_data = timeline_data, + available_data = available_data ) - # Only initiate the sidebar after successful login, because it contains a # modal that pops up if data is out of synch. Modals interfere with shinymanager. observeEvent(r$user_name, { @@ -298,26 +337,16 @@ app_server <- function( id = "main_sidebar_1", r = r, app_data = app_data, - app_tables = app_tables, app_vars = app_vars, navinfo, forms_to_review = reactive({ - with(rev_data$summary(), Form[subject_id == r$subject_id]) + with(rev_data$summary(), item_group[subject_id == r$subject_id]) }), db_path = user_db, available_data = available_data ) }) - mod_review_config_server( - "review_config_1", - r = r, - app_data = app_data, - app_tables = app_tables, - sites = app_vars$Sites, - subject_ids = app_vars$subject_id - ) - mod_queries_server( "queries_1", r = r, @@ -329,7 +358,11 @@ app_server <- function( mod_report_server("report_1", r = r, rev_data, db_path = user_db, table_names = app_vars$table_names) - mod_navigate_participants_server("navigate_participants_1", r) + mod_navigate_participants_server( + "navigate_participants_1", + r, + static_overview_data + ) mod_navigate_review_server( "navigate_review_1", diff --git a/R/app_ui.R b/R/app_ui.R index 9e0178e7..23fcaeb0 100644 --- a/R/app_ui.R +++ b/R/app_ui.R @@ -37,7 +37,7 @@ app_ui <- function(request){ ), bslib::nav_panel( title = "Common events", - bslib::navset_tab(id = "common_data_tabs") + bslib::navset_tab(id = "common_data_tabs") ), bslib::nav_panel( "Study data", diff --git a/R/fct_appdata.R b/R/fct_appdata.R index e4e17c27..2c6212a9 100644 --- a/R/fct_appdata.R +++ b/R/fct_appdata.R @@ -331,21 +331,20 @@ get_appdata <- function( TRUE ~ significance ), out_of_lim = factor(out_of_lim), # for vital signs figures - significance = factor(significance, levels = names(col_palette)), - text_label = paste0( - "", subject_id, "", - "\n", - event_date, - "\n", - event_name, " (day ", - day, ")", - "\nValue: ", - round(item_value, 2), - " ", - item_unit - ) + significance = factor(significance, levels = names(col_palette)) ) |> - dplyr::ungroup() + dplyr::ungroup() |> + add_text_label() + if ("value_standardized" %in% names(df) && !all(is.na(df[["value_standardized"]]))) { + df <- df |> + add_text_label( + label_name = "label_standardized", + value = "value_standardized", + item_unit = "unit_standardized", + lower_lim = "lower_lim_standardized", + upper_lim = "upper_lim_standardized" + ) + } class(df) <- unique(c("continuous", class(x))) df }) @@ -353,3 +352,52 @@ get_appdata <- function( } +#' Add text label +#' +#' Helper function for [get_appdata()]. +#' +#' @param data +#' @keywords internal +add_text_label <- function( + data, + label_name = "text_label", + value = "item_value", + item_unit = "item_unit", + lower_lim = "lower_lim", + upper_lim = "upper_lim", + subject_id = "subject_id", + event_date = "event_date", + event_name = "event_name", + day = "day", + significance = "significance" + ) { + stopifnot(is.data.frame(data)) + data |> + add_missing_columns( + c(value, item_unit, lower_lim, upper_lim, event_date, event_name, day, significance) + ) |> + dplyr::mutate( + "{label_name}" := paste0( + "", .data[[subject_id]], "", + "\n", + .data[[event_date]], + "\n", + .data[[event_name]], " (day ", + .data[[day]], ")", + "\nValue: ", + round(.data[[value]], 2), + " ", + .data[[item_unit]], + "\n", + paste0( + "Limits: ", + ifelse(is.na(.data[[lower_lim]]), "?", .data[[lower_lim]]), + "-", + ifelse(is.na(.data[[upper_lim]]), "?", .data[[upper_lim]]), + "\n", + ifelse(is.na(.data[[significance]]), "Significance unknown", as.character(.data[[significance]])) + ) + ) + ) +} + diff --git a/R/fct_appdata_summary_tables.R b/R/fct_appdata_summary_tables.R index 0e30e6e0..0c5d1a51 100644 --- a/R/fct_appdata_summary_tables.R +++ b/R/fct_appdata_summary_tables.R @@ -4,8 +4,12 @@ #' object. #' #' @param data A list of data frames, with compatible clinical trial data. -#' @param table_data A list of data frames containing clinical trial data in -#' wide format. Created with [create_table()]. +#' @param available_data Optional, data frame with all available data gathered. +#' Used to extract visit information. If not provided, this data frame will be +#' created internally by running [get_available_data()] on the provided `data` +#' list. +#' @param expected_ae_cols Character vector with expected columns for the +#' adverse event table within the `data` list. #' @param timeline_cols Character vector with the name of the columns of the #' output data frame. #' @param treatment_label Character vector with the label to use for the @@ -16,14 +20,23 @@ #' get_timeline_data <- function( data, - table_data, + available_data = NULL, + expected_ae_cols = c( + "AE Name", + "Serious Adverse Event", + "AE start date", + "AE end date", + "SAE Start date", + "SAE End date", + "AE date of worsening", + "CTCAE severity worsening" + ), timeline_cols = c("subject_id", "event_name", "form_repeat", "item_group", "start", "group", "end", "title", "className", "id", "order"), treatment_label = "\U1F48A T\U2093" ){ - stopifnot(is.list(data), is.list(table_data)) + stopifnot(is.list(data)) stopifnot(is.character(timeline_cols), is.character(treatment_label)) - if(all(unlist(lapply(data, is.null)))) return({ warning("No data found. Returning empty data frame") setNames( @@ -32,27 +45,35 @@ get_timeline_data <- function( ) |> dplyr::rename("content" = "event_name") }) + if(is.null(available_data)){ + available_data <- get_available_data(data) + } + stopifnot(is.data.frame(available_data)) + available_data <- available_data |> + add_missing_columns(c("subject_id", "item_name", "form_repeat", + "item_group", "event_name", "event_label", "event_date")) study_event_data <- if(is.null(data) ){ data.frame() } else{ - data |> - bind_rows_custom("item_value") |> - dplyr::filter( - !is.na(event_name), - !is.na(event_date), - event_name != "Any visit" - ) |> + with(available_data, available_data[ + !is.na(event_name) & !event_name %in% c("Any visit") & !is.na(subject_id), + ]) |> dplyr::distinct(subject_id, event_name, start = event_date) |> dplyr::mutate( group = "Visit", title = paste0(start, " | ", event_name) ) } - - if(is.null(table_data$`Adverse events`)){ + ## Get AE data + if(is.null(data[["Adverse events"]]) || nrow(data[["Adverse events"]]) == 0){ AE_timedata <- SAE_data <- data.frame() } else{ - AE_timedata <- table_data$`Adverse events` |> + table_data <- create_table( + data[["Adverse events"]], + expected_columns = expected_ae_cols + ) + + AE_timedata <- table_data |> dplyr::filter(!(`Serious Adverse Event` == "Yes" & .data[["start date"]] == .data[["SAE Start date"]])) |> dplyr::mutate( @@ -74,7 +95,7 @@ get_timeline_data <- function( ) ) - SAE_data <- table_data$`Adverse events` |> + SAE_data <- table_data |> dplyr::filter(`Serious Adverse Event` == "Yes") |> dplyr::mutate( event_name = `Name`, @@ -88,7 +109,7 @@ get_timeline_data <- function( ), start = ifelse(is.na(`SAE Start date`), clean_dates(`start date`), clean_dates(`SAE Start date`)) |> - as.Date(), + as.Date(origin = "1970-01-01"), end = clean_dates(`SAE End date`), className = "bg-danger", title = paste0( @@ -156,11 +177,6 @@ get_timeline_data <- function( #' #' @param data list of data frames to be used. Will be used for extracting the #' variables of interest from the study-specific forms. -#' @param tables list of tables to be used. Will be used for extracting the -#' variables of interest from the common forms. -#' @param all_forms A data frame containing all forms. Mandatory columns are -#' "form" (containing the form names), and "main_tab" (containing the tab name -#' where the form should be located). #' @param form_repeat_name A character string with the name of the `form_repeat` #' variable. This variable (with this name) will be added to the item name if #' duplicate names exist for each participant. @@ -170,37 +186,41 @@ get_timeline_data <- function( #' get_available_data <- function( data, - tables, - all_forms, form_repeat_name = "N" ){ - stopifnot(is.list(data), is.list(tables), is.character(form_repeat_name)) + stopifnot(inherits(data, "list"), is.character(form_repeat_name)) if(identical(form_repeat_name, character(0))){form_repeat_name <- "N"} + selector_cols <- c("subject_id", "item_name", "form_repeat", "item_group", + "event_name", "event_label", "event_date") + if(length(data) == 0) { + warning("Empty list of data provided") + return(add_missing_columns(data.frame(), selector_cols)) + } study_event_selectors <- lapply( - all_forms$form, + data, \(x){ - if(isFALSE("Name" %in% names(tables[[x]]))){ - if(is.null(data[[x]])) return(NULL) - df_x <- data[[x]] |> - dplyr::select( - dplyr::all_of(c("subject_id", "event_name", "event_label", - "item_group", "item_name", "form_repeat")) + name_vars <- c("Name", "AE Name", "CP Name", "MH Name", "CM Name") + if (!all(selector_cols %in% names(x))) { + x <- add_missing_columns(x, selector_cols) |> + dplyr::mutate( + event_date = as.Date(event_date), + form_repeat = as.integer(form_repeat), + event_label = factor(event_label) ) - } else { - if(is.null(tables[[x]])) return(NULL) - df_x <- tables[[x]] |> - dplyr::select(subject_id, "item_name" = Name, form_repeat) |> - dplyr::mutate(item_group = x, event_name = "Any visit", - event_label = "Any visit") } - df_x |> + if ( any(unique(x$item_name) %in% name_vars)){ + x <- x[x$item_name %in% name_vars, ] |> + dplyr::mutate(item_name = item_value) + } + x[!is.na(x$item_name), c(selector_cols)] |> dplyr::distinct() |> - dplyr::arrange( - subject_id, - factor(event_name, levels = order_string(event_name)) - ) + dplyr::arrange(subject_id, event_name) |> + # Because the factor levels differ per table: + dplyr::mutate(item_name = as.character(item_name)) }) |> - dplyr::bind_rows() + dplyr::bind_rows() |> + # to ensure classes created in get_appdata() are dropped, even in edge cases: + as.data.frame() # To uniquely identify events with the same name (mostly in common_forms): study_event_selectors |> dplyr::mutate( @@ -219,36 +239,37 @@ get_available_data <- function( #' Create static overview data -#' -#' Creates overview data of each patient in the study. Used to create the start -#' page of the application. -#' -#' @param data List of data frames. -#' @param expected_general_columns Character vector with the expected columns. -#' If columns are completely missing, they will be made explicitly missing in -#' the data frame (that is, a column will be created with only missing character -#' values). #' -#' @return A data frame with the overview data. Columns are: -#' `subject_id`, `status`, `WHO.classification`, `Age`, `Sex`, `event_name`. -#' -#' @keywords internal +#' Creates overview data of each patient in the study. Used to create the start +#' page of the application. +#' +#' @param data List of data frames. +#' @param available_data A data frame with available data. Visits will be +#' extracted from here. Required columns are `subject_id`, `event_name`, +#' `event_label`. The `event_label` variable should be a factor in order to +#' work well with the function [fig_timeline()]. +#' @param expected_general_columns Character vector with the expected columns. +#' If columns are completely missing, they will be made explicitly missing in +#' the data frame (that is, a column will be created with only missing +#' character values). #' +#' @return A data frame with the overview data. Columns are: `subject_id`, +#' `status`, `WHO.classification`, `Age`, `Sex`, `event_name`. +#' +#' @keywords internal +#' get_static_overview_data <- function( data, + available_data, expected_general_columns = NULL ){ - stopifnot(is.list(data)) + stopifnot(inherits(data, "list")) expected_general_columns <- expected_general_columns %||% character(0) stopifnot(is.character(expected_general_columns)) - visits <- data |> - bind_rows_custom("item_value") |> - dplyr::filter( - !is.na(event_name), - !event_name %in% c("Any visit", "Exit"), - !is.na(subject_id) - ) |> - dplyr::arrange(subject_id, day) |> + visits <- with(available_data, available_data[ + !is.na(event_name) & !event_name %in% c("Any visit", "Exit") &!is.na(subject_id), + ]) |> + dplyr::arrange(subject_id, event_label) |> dplyr::distinct(subject_id, event_name) |> collapse_column_vals(group_by = "subject_id") |> dplyr::distinct() @@ -257,6 +278,5 @@ get_static_overview_data <- function( data[["General"]], expected_columns = expected_general_columns ) |> - dplyr::select(tidyr::all_of("subject_id"), tidyr::any_of(c("subject_status", "WHO.classification", "Age", "Sex"))) |> dplyr::left_join(visits, by = "subject_id") } diff --git a/R/fct_customize_clinsight_helpers.R b/R/fct_customize_clinsight_helpers.R index ad12cbcf..13e31431 100644 --- a/R/fct_customize_clinsight_helpers.R +++ b/R/fct_customize_clinsight_helpers.R @@ -44,7 +44,7 @@ create_clinsight_config <- function( path = ".", template_path = app_sys("golem-config.yml") ){ - config_path <- file.path(path, "clinsight_config.yml") + config_path <- file.path(path, "clinsight-config.yml") if(file.exists(config_path)){ stop("The file '", config_path, "' already exists.", " Delete or rename this file and try again.") @@ -53,7 +53,8 @@ create_clinsight_config <- function( message( "Creating a customizable ClinSight config file in the following location:\n'", config_path, "'.\n\n", - "To use it with ClinSight, set the path in the environment variable 'CONFIG_PATH':\n", + "To use this file, place it in the working directory when starting ClinSight.\n", + "Alternatively, set the path in the environment variable 'CONFIG_PATH':\n", " 'Sys.setenv('CONFIG_PATH' = '", config_path, "')'\n" ) file.edit(config_path) diff --git a/R/fct_data_helpers.R b/R/fct_data_helpers.R index ad66a6b6..ff861df5 100644 --- a/R/fct_data_helpers.R +++ b/R/fct_data_helpers.R @@ -196,36 +196,41 @@ fix_multiple_choice_vars <- function( all_vars <- unique(data[[var_column]]) missing_vars <- expected_vars[!expected_vars %in% all_vars] - if(length(missing_vars) == 0) return(data) + if (length(missing_vars) == 0) { + return(data) + } vars_to_adjust <- lapply( - missing_vars, + setNames(nm = missing_vars), \(x){all_vars[grep(paste0("^", x, suffix), all_vars)] } ) + vars_to_adjust <- vars_to_adjust[sapply(vars_to_adjust, length) != 0] - multiple_choice_vars <- missing_vars[sapply(vars_to_adjust, length) != 0] - if(length(multiple_choice_vars) == 0) return(data) - cat("multiple choice vars that will be adjusted: ", multiple_choice_vars, sep = "\n") - data_adjusted <- data |> - dplyr::filter(.data[[var_column]] %in% unlist(vars_to_adjust), !is.na(.data[[value_column]])) |> - dplyr::arrange(.data[[var_column]]) |> - dplyr::mutate(var = gsub(suffix, "", var)) - if(!is.null(collapse_with)){ - # Probably redundant since the variables will be collapsed already in the - # functions `create_table.xxx`. - data_adjusted <- data_adjusted |> - dplyr::mutate( - item_value = paste0(item_value, collapse = collapse_with), - .by = dplyr::all_of(c(var_column, key_cols)) - ) - } - # note: Column edit_date_time can still cause multiple rows after step below. - data_adjusted <- dplyr::distinct(data_adjusted) + if(length(vars_to_adjust) == 0) return(data) + cat("multiple choice vars that will be adjusted: ", names(vars_to_adjust), sep = "\n") - df <- data |> - dplyr::filter(!.data[[var_column]] %in% unlist(vars_to_adjust)) |> - dplyr::bind_rows(data_adjusted) - df + for (i in names(vars_to_adjust)) { + cat(sprintf("Converting var '%s' to '%s'\n", vars_to_adjust[[i]], i), sep = "") + data[[var_column]] <- ifelse(data[[var_column]] %in% vars_to_adjust[[i]], i, data[[var_column]]) + } + if (is.null(collapse_with)) { + return(data) + } + data_adjusted <- data |> + dplyr::filter( + .data[[var_column]] %in% names(vars_to_adjust) + ) |> + dplyr::summarize( + item_value = ifelse( + all(is.na(item_value)), + NA, + paste0(na.omit(item_value), collapse = collapse_with) + ), + .by = dplyr::all_of(c(key_cols, var_column)) + ) + data |> + dplyr::rows_update(data_adjusted, by = c(key_cols, var_column)) |> + dplyr::distinct() } @@ -497,12 +502,16 @@ add_missing_columns <- function( #' needed. #' @param export_label Character string with the table export label. Only used #' for downloadable tables (if `allow_listing_download` is `TRUE`). +#' @param escape Whether to escape HTML entities in the table. See +#' [DT::datatable()]. +#' @param enable_text_wrap Logical, whether to enable text wrapping in the +#' table. If TRUE, pagination will be used and `deferRender` disabled. #' @param ... Other optional arguments that will be passed to [DT::datatable()]. #' #' @return A `DT::datatable` object. #' @keywords internal #' -#' @examples +#' @examples #' \dontrun{ #' datatable_custom(mtcars) #' } @@ -516,6 +525,8 @@ datatable_custom <- function( options = list(), allow_listing_download = NULL, export_label = NULL, + escape = TRUE, + enable_text_wrap = FALSE, ... ){ stopifnot(is.data.frame(data)) @@ -524,6 +535,17 @@ datatable_custom <- function( stopifnot(is.character(rename_vars)) colnames <- dplyr::rename(data[0,], dplyr::any_of(rename_vars)) |> names() + } + if (isFALSE(escape)) { + colnames <- lapply( + colnames, + \(cn) as.character(tags$span( + cn, + class = "cs-span-overflow", + title = cn + )) + ) |> + as.character() } stopifnot(is.null(title) | is.character(title)) stopifnot(grepl("t", dom, fixed = TRUE)) @@ -534,17 +556,20 @@ datatable_custom <- function( stopifnot(is.null(export_label) | is.character(export_label)) default_opts <- list( - scrollY = 400, + scrollY = if (isFALSE(enable_text_wrap)) 400 else NULL, scrollX = TRUE, - scroller = TRUE, - deferRender = TRUE, - scrollCollapse = TRUE, + scroller = isFALSE(enable_text_wrap), + deferRender = isFALSE(enable_text_wrap), + scrollCollapse = isFALSE(enable_text_wrap), colReorder = list( enable = TRUE, realtime = FALSE, fixedColumnsLeft = 1 ) ) + if (isTRUE(enable_text_wrap)) { + dom <- paste0(dom, "p") + } fixed_opts <- list( initComplete = DT::JS( "function() {", @@ -565,8 +590,7 @@ datatable_custom <- function( fixed_opts[["buttons"]] <- list(list( extend = 'excel', text = '', - filename = paste("clinsight", export_label, sep = "."), - title = paste0(export_label, " | extracted from ClinSight") + action = DT::JS('hiddenDownloadHandlerTrigger') )) fixed_opts[["dom"]] <- paste0('B', fixed_opts[["dom"]]) } @@ -574,13 +598,14 @@ datatable_custom <- function( opts <- default_opts |> modifyList(options) |> modifyList(fixed_opts) - + DT::datatable( data, selection = selection, options = opts, extensions = extensions, colnames = colnames, + escape = escape, ... ) } diff --git a/R/fct_figures.R b/R/fct_figures.R index 39b4ad3f..95b7e6b3 100644 --- a/R/fct_figures.R +++ b/R/fct_figures.R @@ -101,8 +101,8 @@ fig_timeline <- function( completed_events <- all_events[ all_events$event_label %in% labels_in_data, , drop = FALSE] - uneven_events <- all_events[1:length(all_events$event_label) %% 2 == 0, , drop = FALSE] - even_events <- all_events[1:length(all_events$event_label) %% 2 != 0, , drop = FALSE] + uneven_events <- all_events[seq_len(length(all_events$event_label)) %% 2 == 0, , drop = FALSE] + even_events <- all_events[seq_len(length(all_events$event_label)) %% 2 != 0, , drop = FALSE] fig <- ggplot2::ggplot( mapping = ggplot2::aes(x = event_label, y = factor(1)) ) + @@ -163,12 +163,14 @@ fig_timeline <- function( #' @param label Character vector. Label to be used for each data point. Will #' only be visible if the ggplot object is converted to an interactive plot #' using `plotly::ggplotly()`. See [plotly_figure()] -#' @param scale A logical. Whether to us a scaled value (value_scaled) or the -#' raw variable (item_value). #' @param use_unscaled_limits If TRUE, limits provided in the data frame will be #' used. This parameter will be ignored if scaled is set to `TRUE`. #' @param point_size character vector. Column in the data frame that controls #' the point size in the figure. +#' @param show_all_participants Logical to toggle background patterns. +#' @param show_all_hover_labels Logical to toggle hover labels. +#' @param yval Character vector with the column name with the values. Must be +#' numeric. #' #' @return A faceted ggplot2 time series figure. #' @keywords internal @@ -183,9 +185,9 @@ fig_timeline <- function( #' item_name = sample(c("item1", "item2"), 10, replace = TRUE), #' item_value = runif(10, 0 , 50), #' significance = sample( -#' c("limits unknown", "out of limits, clinically significant", -#' "out of limits, clinically insignificant"), -#' 10, +#' c("limits unknown", "out of limits, clinically significant", +#' "out of limits, clinically insignificant"), +#' 10, #' replace = TRUE #' ), #' text_label = "test text", @@ -204,19 +206,39 @@ fig_timeseries <- function( color_fill = "significance", point_size = "reviewed", label = "text_label", - scale = FALSE, + show_all_participants = TRUE, + show_all_hover_labels = FALSE, + yval = "item_value", use_unscaled_limits = FALSE ){ + if(isTRUE(is.na(id_to_highlight))){ + id_to_highlight <- NULL + } df_id <- data[data[[id]] == id_to_highlight, ] - yval <- ifelse(scale, "value_scaled", "item_value") - fig <- ggplot2::ggplot(data, ggplot2::aes(x = .data[[xval]], - y = .data[[yval]], - group = .data[[id]] - )) + + if ("character" %in% class(data[[yval]])) { + warning(paste0("converting yval ", yval, " to numeric")) + data[[yval]] <- as.numeric(data[[yval]]) + } + if (is.null(data[[label]])) { + label <- "text_label" + } + + fig <- ggplot2::ggplot( + data, + ggplot2::aes( + x = .data[[xval]], + y = .data[[yval]], + group = .data[[id]] + ) + ) + ggplot2::facet_wrap(~item_name, ncol = 2, scales = "free_y") + ggplot2::scale_fill_manual(values = col_palette) + ggplot2::scale_x_continuous(limits = \(x){ - c(0, pmax(x[2], 3)) # keeps minimum scale of 3 days if not much data is available + if(length(x) == 0) return(c(0,3)) + c( + pmin(x[1], 0), # Always include day zero. + pmax(x[2], 3) # keeps minimum scale of 3 days if not much data is available + ) }) + ggplot2::scale_y_continuous(expand = ggplot2::expansion(c(0.15, 0.1))) + custom_plot_theme() + @@ -225,18 +247,35 @@ fig_timeseries <- function( y = "value" ) + list( - if(scale){ + if(identical(yval, "value_scaled")){ list( lapply(c(0,1), \(x){ ggplot2::geom_hline(yintercept = x,lty = 3, linewidth = 0.5, col = "grey50") }), ggplot2::labs(y = "Scaled value (>1 or <0 is out of range)") ) - } else if(use_unscaled_limits){ - list(ggplot2::geom_hline(ggplot2::aes(yintercept = .data[["upper_lim"]]),lty = 3, linewidth = 0.5, col = "grey50"), - ggplot2::geom_hline(ggplot2::aes(yintercept = .data[["lower_lim"]]),lty = 3, linewidth = 0.5, col = "grey50")) + } else if (nrow(df_id) != 0) { + lower_lim <- switch(yval, "item_value" = "lower_lim", "value_standardized" = "lower_lim_standardized", "") + upper_lim <- switch(yval, "item_value" = "upper_lim", "value_standardized" = "upper_lim_standardized", "") + + lapply(c(lower_lim, upper_lim), \(x){ + if (!x %in% names(df_id)) { + return(NULL) + } + df_ranges <- dplyr::distinct(na.omit(df_id[c(id, "item_name", x)])) + if (nrow(df_ranges) == 0) { + return(NULL) + } + ggplot2::geom_hline(data = df_ranges, ggplot2::aes(yintercept = .data[[x]]),lty = 3, linewidth = 0.5, col = "grey50") + }) + }, + if(isTRUE(show_all_participants) && isTRUE(show_all_hover_labels)) { + suppressWarnings( + ggplot2::geom_line(alpha = 0.2, mapping = ggplot2::aes(text = .data[[label]])) + ) + } else if(show_all_participants){ + ggplot2::geom_line(alpha = 0.2) }, - ggplot2::geom_line(alpha = 0.2), ggplot2::scale_size_manual(values = setNames(c(2,4), c("Yes", "No"))) ) @@ -247,7 +286,7 @@ fig_timeseries <- function( # at the moment it is only implemented when figure uses scaled figures since # it sets the limits for all facets, which is undesirable if the units differ per facet. # note that this still skews all figures - if(!scale){ + if (!identical(yval, "value_scaled")) { y_range <- NULL } else{ y_range <- range(c(0, 1, df_id[[yval]]), na.rm = TRUE) diff --git a/R/fct_tables.R b/R/fct_tables.R index 2904832f..7ac32474 100644 --- a/R/fct_tables.R +++ b/R/fct_tables.R @@ -88,10 +88,12 @@ create_table.default <- function( add_row_review_status <- function(data, id_cols) { dplyr::mutate( data, - row_review_status = 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)) + row_review_status = ifelse( + any(reviewed == "No") & any(reviewed == "Yes"), list(list(reviewed = NA, ids = id)), + ifelse( + any(reviewed == "Yes"), list(list(reviewed = TRUE, ids = id)), + list(list(reviewed = FALSE, ids = id)) + ) ), .by = dplyr::all_of(id_cols)) } diff --git a/R/fct_utils.R b/R/fct_utils.R index c1ce09d9..ac7ffe96 100644 --- a/R/fct_utils.R +++ b/R/fct_utils.R @@ -790,7 +790,15 @@ expectation_type <- function( #' custom_config_path <- function( ){ - Sys.getenv("CONFIG_PATH", app_sys("golem-config.yml")) + config_path <- Sys.getenv("CONFIG_PATH") + if (file.exists(config_path)) { + return(config_path) + } + if (file.exists("clinsight-config.yml")) { + "clinsight-config.yml" + } else { + app_sys("golem-config.yml") + } } dblclick_to_form <- function(bttn_ns, button_id = "go_to_form") { diff --git a/R/mod_common_forms.R b/R/mod_common_forms.R index 04b76181..63ec6f60 100644 --- a/R/mod_common_forms.R +++ b/R/mod_common_forms.R @@ -7,23 +7,25 @@ mod_common_forms_ui <- function(id, form){ ns <- NS(id) bslib::nav_panel( title = form, - if (form == "Adverse events") { - bslib::card_body(id = ns("timeline_card"), mod_timeline_ui(ns("timeline_fig"))) - }, bslib::layout_sidebar( fillable = FALSE, if(form == "Adverse events"){ - mod_review_form_tbl_ui(ns("review_form_SAE_tbl")) + div( + mod_review_form_tbl_ui(ns("review_form_SAE_tbl")), + class = "sae_table_custom" + ) }, mod_review_form_tbl_ui(ns("review_form_tbl")), sidebar = bslib::sidebar( bg = "white", position = "right", - shinyWidgets::materialSwitch( - inputId = ns("show_all_data"), - label = "Show all participants", - status = "primary", - right = TRUE + bslib::input_switch( + id = ns("show_all_data"), + label = span(icon("people-group"), "All subjects") + ), + bslib::input_switch( + id = ns("enable_text_wrap"), + label = span(tags$img(src="www/text-wrap.svg", class = "textwrap-switch-icon"), "Text wrap") ), bslib::card_body( HTML("Bold*: New/updated data"), @@ -44,11 +46,7 @@ mod_common_forms_ui <- function(id, form){ #' changed in the metadata. The tables shown are overview tables in wide format, #' similar to the ones in [mod_study_forms_server()]. When the common form #' `Adverse events` is selected, the module will show an additional table with -#' Severe Adverse Events above the table with Adverse Events. In addition, it -#' will show a timeline by calling module -#' [mod_timeline_ui()]/[mod_timeline_server()]. The timeline shows study events -#' (such as drug administrations) and study visits together with Adverse Events, -#' so that temporal relationships between these events can be quickly revealed. +#' Severe Adverse Events above the table with Adverse Events. #' The `common forms` module is used in the main server to create all applicable #' common form pages. #' @@ -74,10 +72,6 @@ mod_common_forms_ui <- function(id, form){ #' @param table_names An optional character vector. If provided, will be used #' within [datatable_custom()], to improve the column names in the final #' interactive tables. -#' @param timeline_data A reactive with a data frame containing the timeline -#' data. Used to create the timeline figure. Created with -#' [get_timeline_data()]. -#' #' #' @seealso [mod_common_forms_ui()], [mod_timeline_ui()], #' [mod_timeline_server()], [mod_review_form_tbl_ui()], @@ -92,8 +86,7 @@ mod_common_forms_server <- function( active_subject, id_item = c("subject_id", "event_name", "item_group", "form_repeat", "item_name"), - table_names = NULL, - timeline_data + table_names = NULL ){ stopifnot(is.character(form), length(form) == 1) stopifnot(is.reactive(form_data), is.reactive(form_review_data)) @@ -101,7 +94,6 @@ mod_common_forms_server <- function( stopifnot(is.reactive(active_subject)) stopifnot(is.character(id_item)) stopifnot(is.null(table_names) || is.character(table_names)) - stopifnot(is.reactive(timeline_data)) names(form_items) <- names(form_items) %||% form_items moduleServer( id, function(input, output, session){ @@ -110,21 +102,24 @@ mod_common_forms_server <- function( observeEvent(session$userData$review_type(), { golem::cat_dev(form, "| Updating tables to show '", session$userData$review_type(), "' level data\n", sep = "") - shinyWidgets::updateMaterialSwitch( + bslib::update_switch( session = session, - inputId = "show_all_data", + id = "show_all_data", value = identical(session$userData$review_type(), "form") ) shinyjs::toggleState( id = "show_all_data", condition = identical(session$userData$review_type(), "subject") ) - if(form == "Adverse events"){ - shinyjs::toggleElement( - id = "timeline_card", - condition = identical(session$userData$review_type(), "subject") - ) - } + }) + + observeEvent(input$show_all, { + req(isTRUE(input$show_all)) + bslib::update_switch( + session = session, + id = "enable_text_wrap", + value = FALSE + ) }) mod_review_form_tbl_server( @@ -135,6 +130,7 @@ mod_common_forms_server <- function( form_items = form_items, active_subject = active_subject, show_all = reactive(isTRUE(input$show_all_data) | identical(session$userData$review_type(), "form") ), + enable_text_wrap = reactive(isTRUE(input$enable_text_wrap)), table_names = table_names, title = form ) @@ -148,15 +144,10 @@ mod_common_forms_server <- function( form_items = form_items, active_subject = active_subject, show_all = reactive(isTRUE(input$show_all_data) | identical(session$userData$review_type(), "form") ), + enable_text_wrap = reactive(isTRUE(input$enable_text_wrap)), table_names = table_names, title = "Serious Adverse Events" ) - mod_timeline_server( - "timeline_fig", - form_review_data = form_review_data, - timeline_data = timeline_data, - active_subject = active_subject - ) } }) diff --git a/R/mod_go_to_form.R b/R/mod_go_to_form.R index d36c3109..2bf597c0 100644 --- a/R/mod_go_to_form.R +++ b/R/mod_go_to_form.R @@ -58,7 +58,7 @@ mod_go_to_form_server <- function( navtable, tablerow, all_forms, - form_name = "Form", + form_name = "item_group", subject_id = "subject_id" ){ stopifnot(is.reactivevalues(r)) diff --git a/R/mod_header_widgets.R b/R/mod_header_widgets.R index bb813cf7..3d2194ac 100644 --- a/R/mod_header_widgets.R +++ b/R/mod_header_widgets.R @@ -20,7 +20,8 @@ mod_header_widgets_ui <- function(id){ class = "timeline-fig-basic" ), class = "top-widgets-custom" - ) + ), + mod_timeline_ui(ns("timeline_fig")) ) } @@ -38,7 +39,7 @@ mod_header_widgets_ui <- function(id){ #' form. Furthermore, clicking on the box with forms to review will trigger #' [mod_navigate_review_server()], opening a modal that shows the forms that #' need review and the queries that are open of the active participant, to which -#' you can directly navigate to. +#' you can directly navigate to. #' #' @param id Character string, used to connect the module UI with the module #' Server. @@ -47,53 +48,48 @@ mod_header_widgets_ui <- function(id){ #' @param navinfo Reactive values created with [shiny::reactiveValues()]. Used #' to send back information about the page change to the server, when clicking #' on the adverse event box. +#' @param timeline_data A reactive with a data frame containing the timeline +#' data. Used to create the timeline figure. Created with +#' [get_timeline_data()]. +#' @param available_data A data frame containing all available data, usually +#' created with the function [get_available_data()]. #' #' @seealso [mod_header_widgets_ui()] -mod_header_widgets_server <- function(id, r, rev_data, navinfo){ +mod_header_widgets_server <- function( + id, + r, + rev_data, + navinfo, + timeline_data, + available_data + ){ stopifnot(is.reactivevalues(r)) stopifnot(is.reactivevalues(navinfo)) stopifnot(is.reactivevalues(rev_data)) + stopifnot(is.data.frame(available_data)) + stopifnot(is.data.frame(timeline_data)) moduleServer( id, function(input, output, session){ ns <- session$ns - # for use in valueboxes for individuals: - AEvalue.individual <- reactiveVal("...") - SAEvalue.individual <- reactiveVal("...") - visit.number <- reactiveVal(".. (..%)") - AEvals_active <- reactive({ - req(r$subject_id) - validate(need(r$filtered_tables$`Adverse events`, "AE data missing for selected patient")) - r$filtered_tables$`Adverse events` |> - dplyr::filter(subject_id == as.character(r$subject_id)) |> - dplyr::distinct(subject_id, form_repeat, `Serious Adverse Event`) - }) + observe({ + if (is.null(navinfo$cf_toggle_timeline)) { + navinfo$cf_toggle_timeline <- reactiveVal(TRUE) + } + if (is.null(navinfo$sf_toggle_timeline)) { + navinfo$sf_toggle_timeline <- reactiveVal(FALSE) + } + }, + autoDestroy = TRUE + ) - observeEvent(r$subject_id, { - req(r$subject_id != "") - golem::cat_dev("Update individual valueboxes\n") - - AEvalue.individual( - sum(AEvals_active()[["Serious Adverse Event"]] != "Yes", na.rm = T) + all_aes <- reactive({ + validate(need(r$filtered_data[["Adverse events"]], "AE data missing")) + count_adverse_events( + data = r$filtered_data[["Adverse events"]], + all_ids = unique(available_data$subject_id) ) - SAEvalue.individual( - sum(AEvals_active()[["Serious Adverse Event"]] == "Yes", na.rm = T) - ) - }) - simple_timeline_data <- reactive({ - bind_rows_custom(r$filtered_data, "item_value") |> - dplyr::select(dplyr::all_of(c("subject_id", "event_name", - "event_label", "item_name"))) |> - dplyr::distinct() - }) - - selected_individual_data <- reactiveVal() - observeEvent(r$subject_id, { - selected_individual_data( - with(simple_timeline_data(), - simple_timeline_data()[subject_id %in% r$subject_id, ]) - ) - }) + }) shinyjs::onclick("ae_box", { navinfo$active_tab = "Common events" @@ -105,18 +101,37 @@ mod_header_widgets_server <- function(id, r, rev_data, navinfo){ req(rev_data$summary()) req(r$subject_id) revs <- with(rev_data$summary(), reviewed[ - subject_id == r$subject_id & Form == "Adverse events"]) + subject_id == r$subject_id & item_group == "Adverse events"]) !("No" %in% revs) }) + observeEvent(c(navinfo$sf_toggle_timeline(), navinfo$active_tab), { + req(identical(navinfo$active_tab, "Study data")) + golem::cat_dev("sf_toggle_timeline switch input is ", navinfo$sf_toggle_timeline(), "\n", sep = "") + shinyjs::toggleElement( + id = "timeline_fig-timeline", + anim = TRUE, + condition = navinfo$sf_toggle_timeline() + ) + }) + + observeEvent(c(navinfo$cf_toggle_timeline(), navinfo$active_tab), { + req(identical(navinfo$active_tab, "Common events")) + golem::cat_dev("cf_toggle_timeline switch input is ", navinfo$cf_toggle_timeline(), "\n", sep = "") + shinyjs::toggleElement( + id = "timeline_fig-timeline", + anim = TRUE, + condition = navinfo$cf_toggle_timeline() + ) + }) + ### Outputs: - + output[["ae_box"]] <- renderUI({ - req(inherits(all_AEs_reviewed(), "logical"), SAEvalue.individual(), - AEvalue.individual(), r$subject_id) + req(inherits(all_AEs_reviewed(), "logical"), r$subject_id) bslib::value_box( - title = paste0("SAEs: ", SAEvalue.individual()), - value = paste0("AEs: ", AEvalue.individual()), + title = paste0("SAEs: ", with(all_aes(), SAEs[subject_id == r$subject_id]) ), + value = paste0("AEs: ", with(all_aes(), AEs[subject_id == r$subject_id])), showcase = icon("house-medical", class = 'fa-2x'), theme = if(all_AEs_reviewed()) "primary" else "warning" ) @@ -124,10 +139,18 @@ mod_header_widgets_server <- function(id, r, rev_data, navinfo){ output[["visit_figure"]] <- renderPlot( { golem::cat_dev("plot datapoints figure\n") - fig_timeline(data = selected_individual_data()) + fig_timeline( + data = available_data[available_data$subject_id %in% r$subject_id, ] + ) }, height = 60 ) + mod_timeline_server( + "timeline_fig", + form_review_data = reactive(r$review_data[["Adverse events"]]), + timeline_data = timeline_data, + active_subject = reactive(r$subject_id) + ) }) } diff --git a/R/mod_header_widgets_fct_helpers.R b/R/mod_header_widgets_fct_helpers.R new file mode 100644 index 00000000..ec0019c1 --- /dev/null +++ b/R/mod_header_widgets_fct_helpers.R @@ -0,0 +1,53 @@ +#' Count Adverse Events +#' +#' Simple helper function to count Adverse Events (AEs) and Serious Adverse +#' Events (SAEs). +#' +#' @param data A data frame with Adverse Event data. Required columns are the +#' clinsight `key_cols` and the column `item_value`. +#' +#' @returns A data frame with the columns `subject_id`, `AEs` (number of AEs per +#' subject), `SAEs` (number of SAEs per subject). +#' @keywords internal +count_adverse_events <- function( + data, + all_ids = NULL, + SAE_column_name = "Serious Adverse Event" + ){ + stopifnot(is.data.frame(data)) + if (nrow(data) == 0 ) { + return({ + data.frame(subject = character(), AEs = numeric(), SAEs = numeric()) + }) + } + stopifnot("One or more required columns are missing" = all(c(key_columns, "item_value") %in% names(data))) + all_ids <- unique(c(all_ids, unique(data[["subject_id"]]))) + stopifnot(is.character(all_ids)) + if (!SAE_column_name %in% data$item_name) { + warning("item '", SAE_column_name, "' not found. Unable to determine (S)AE numbers.") + return( + data.frame(subject_id = all_ids, AEs = "?", SAEs = "?") + ) + } + + ae_data <- dplyr::left_join( + unique(data[c("subject_id", "form_repeat")]), + unique(data[data$item_name %in% SAE_column_name, c(key_columns, "item_value")]), + by = c("subject_id", "form_repeat") + ) |> + dplyr::mutate( + item_value = ifelse(is.na(item_value), "No", item_value) + ) + all_aes <- data.frame(subject_id = all_ids) |> + dplyr::left_join( + ae_data, + by = "subject_id" + ) + + all_aes |> + dplyr::summarize( + AEs = sum(item_value == "No", na.rm = TRUE), + SAEs = sum(item_value == "Yes", na.rm = TRUE), + .by = subject_id + ) +} diff --git a/R/mod_main_sidebar.R b/R/mod_main_sidebar.R index da93052e..5ec4231d 100644 --- a/R/mod_main_sidebar.R +++ b/R/mod_main_sidebar.R @@ -63,8 +63,6 @@ mod_main_sidebar_ui <- function(id){ #' @param app_data List of data frames. Contains the application data, with data #' of each form stored in a data frame. Required to set the review #' configuration in [mod_review_config_server()]. -#' @param app_tables List of data frames with the app data in wide table format. -#' Required to set the review configuration in [mod_review_config_server()] #' @param app_vars A list with common variables found in the data and metadata. #' Required to set the review configuration in [mod_review_config_server()]. #' @param forms_to_review A reactive value containing a character vector with @@ -83,7 +81,6 @@ mod_main_sidebar_server <- function( r, navinfo, app_data, - app_tables, app_vars, db_path, forms_to_review, @@ -139,7 +136,6 @@ mod_main_sidebar_server <- function( "review_config_1", r = r, app_data = app_data, - app_tables = app_tables, sites = app_vars$Sites, subject_ids = app_vars$subject_id ) diff --git a/R/mod_navigate_participants.R b/R/mod_navigate_participants.R index 2d758e34..62bc1923 100644 --- a/R/mod_navigate_participants.R +++ b/R/mod_navigate_participants.R @@ -11,25 +11,31 @@ mod_navigate_participants_ui <- function(id){ } #' Navigate participants - Shiny module Server -#' -#' A `shiny` module. Used to show participant information in a -#' [bslib::value_box()]. By clicking on the [bslib::value_box()], additional -#' participant information will be shown, as well as a selection menu to select -#' a different subject. Once the subject is changed, the active `subject_id` will -#' be changed in the application. #' -#' @param id Character string, used to connect the module UI with the module Server. -#' @param r Common `reactiveValues`. Used to access `filtered_tables$General`, -#' containing a data frame with general data to be displayed in the participant -#' selection modal. -#' In addition, it will be used to access the list of `filtered_subjects` -#' (character vector), and the currently active `subject_id` (character string). -#' The only parameter that the module will change, if requested by the user, -#' is `subject_id`. +#' A `shiny` module. Used to show participant information in a +#' [bslib::value_box()]. By clicking on the [bslib::value_box()], additional +#' participant information will be shown, as well as a selection menu to select +#' a different subject. Once the subject is changed, the active `subject_id` +#' will be changed in the application. +#' +#' @param id Character string, used to connect the module UI with the module +#' Server. +#' @param r Common `reactiveValues`. Used to access `filtered_tables$General`, +#' containing a data frame with general data to be displayed in the +#' participant selection modal. In addition, it will be used to access the +#' list of `filtered_subjects` (character vector), and the currently active +#' `subject_id` (character string). The only parameter that the module will +#' change, if requested by the user, is `subject_id`. +#' @param static_overview_data Data frame created with +#' [get_static_overview_data()]. #' #' @seealso [mod_navigate_participants_ui()] for the UI function #' -mod_navigate_participants_server <- function(id, r){ +mod_navigate_participants_server <- function( + id, + r, + static_overview_data = NULL + ){ moduleServer( id, function(input, output, session){ ns <- session$ns @@ -111,10 +117,10 @@ mod_navigate_participants_server <- function(id, r){ }) general_info_missing_error <- reactive({ - if(is.null(r$filtered_tables$General)) { + if(is.null(static_overview_data)) { return("Warning: No general information found in the database.") } - if(!r$subject_id %in% with(r$filtered_tables$General, subject_id) ) { + if(!r$subject_id %in% with(static_overview_data, subject_id) ) { return( paste0("Warning: no general information found for subject ", r$subject_id) ) @@ -124,9 +130,7 @@ mod_navigate_participants_server <- function(id, r){ output[["status"]] <- renderText({ req(input$participant_selection) if(!is.null(general_info_missing_error())) return(HTML(general_info_missing_error())) - df <- r$filtered_tables$General |> - dplyr::filter(subject_id == input$participant_selection) - df$status_label + with(static_overview_data, status_label[subject_id == input$participant_selection]) }) subject_info <- reactive({ @@ -136,8 +140,7 @@ mod_navigate_participants_server <- function(id, r){ status_icon = icon("circle-question", class = 'fa-2x') ) } else{ - active_pt_info <- r$filtered_tables$General |> - subset(subject_id == r$subject_id) |> + active_pt_info <- static_overview_data[static_overview_data$subject_id == r$subject_id, ] |> add_missing_columns("subject_status") list( pt_info = paste0(active_pt_info$Sex, ", ", active_pt_info$Age, "yrs."), diff --git a/R/mod_navigate_review.R b/R/mod_navigate_review.R index 7027560a..f76c5ba9 100644 --- a/R/mod_navigate_review.R +++ b/R/mod_navigate_review.R @@ -109,13 +109,13 @@ mod_navigate_review_server <- function( observeEvent(rev_data$open_modal, { cat("review details click detected\n") r$subject_id <- rev_data$subject - shinyWidgets::updateMaterialSwitch(session, "show_all_data", value = rev_data$show_all) + bslib::update_switch("show_all_data", value = rev_data$show_all, session = session) showModal(modal_nav_review()) }, ignoreInit = TRUE) shinyjs::onclick("review_value_box", { golem::cat_dev("click on forms to review detected\n") - shinyWidgets::updateMaterialSwitch(session, "show_all_data", value = FALSE) + bslib::update_switch("show_all_data", value = FALSE, session = session) showModal(modal_nav_review()) }) @@ -174,7 +174,7 @@ mod_navigate_review_server <- function( ) forms_to_review <- reactive({ - with(rev_data$summary(), Form[subject_id == r$subject_id]) + with(rev_data$summary(), item_group[subject_id == r$subject_id]) }) output[["forms_to_review"]] <- renderText({ diff --git a/R/mod_queries.R b/R/mod_queries.R index 5a2da066..31a15afd 100644 --- a/R/mod_queries.R +++ b/R/mod_queries.R @@ -150,9 +150,6 @@ mod_queries_server <- function(id, r, navinfo, all_forms, db_path, table_names){ table_title <- "All queries" } - # determine DT dom / exts / opts - - datatable_custom( initial_queries()[query_cols], table_names, diff --git a/R/mod_query_add.R b/R/mod_query_add.R index 6e2c5149..501c52bf 100644 --- a/R/mod_query_add.R +++ b/R/mod_query_add.R @@ -134,9 +134,17 @@ mod_query_add_server <- function( ) } + allowed_to_query <- reactive({ + get_roles_from_config()[r$user_role] %in% get_golem_config("allow_to_query") + }) + + observeEvent(allowed_to_query(), { + shinyjs::toggleElement("create_query", condition = allowed_to_query()) + }) + selected_data <- reactiveVal() observeEvent(input$create_query, { - req(available_data, r$subject_id, active_form()) + req(available_data, r$subject_id, active_form(), allowed_to_query()) df <- with(available_data, available_data[ subject_id == r$subject_id & item_group == active_form(), ]) diff --git a/R/mod_query_follow_up.R b/R/mod_query_follow_up.R index e41a3ba0..90333697 100644 --- a/R/mod_query_follow_up.R +++ b/R/mod_query_follow_up.R @@ -47,29 +47,33 @@ mod_query_follow_up_server <- function(id, r, selected_query, db_path){ moduleServer( id, function(input, output, session){ ns <- session$ns + is_resolved <- reactiveVal() observeEvent(selected_query(), { - is_resolved <- any( + is_resolved(any( with(r$query_data, resolved[query_id == selected_query()]) == "Yes" - ) - shiny::updateCheckboxInput(inputId = "resolved", value = is_resolved) + )) + shiny::updateCheckboxInput(inputId = "resolved", value = is_resolved()) shiny::updateTextAreaInput( inputId = "query_follow_up_text", placeholder = ifelse( - is_resolved, + is_resolved(), "query is resolved", "add response here" ) ) - if(is_resolved){ - shinyjs::disable("query_follow_up") - } else{ - shinyjs::enable("query_follow_up") - } + shinyjs::toggleState("query_follow_up", condition = isFALSE(is_resolved())) }) + + allowed_to_resolve <- reactive({ + get_roles_from_config()[r$user_role] %in% get_golem_config("allow_to_query") + }) + observe(shinyjs::toggleElement("resolved", condition = allowed_to_resolve())) + query_save_error <- reactiveVal(FALSE) observeEvent(input$query_add_follow_up, { req(input$query_follow_up_text, r$user_name, r$user_role, selected_query()) req(selected_query() %in% r$query_data$query_id) + req(isFALSE(is_resolved())) query_save_error(FALSE) golem::cat_dev("Query FU text to add: ", input$query_follow_up_text, "\n") ts <- time_stamp() @@ -83,8 +87,8 @@ mod_query_follow_up_server <- function(id, r, selected_query, db_path){ "n" = n + 1, "reviewer" = paste0(r$user_name," (", r$user_role, ")"), "query" = input$query_follow_up_text, - "resolved" = ifelse(input$resolved, "Yes", "No"), - `resolved_date` = if(input$resolved) ts else NA_character_, + "resolved" = if (input$resolved && isTRUE(allowed_to_resolve())) "Yes" else "No", + `resolved_date` = if (input$resolved && isTRUE(allowed_to_resolve())) ts else NA_character_, "edit_reason" = NA_character_ ) golem::print_dev(updated_query) diff --git a/R/mod_review_config.R b/R/mod_review_config.R index aad734e4..571afdf7 100644 --- a/R/mod_review_config.R +++ b/R/mod_review_config.R @@ -31,12 +31,11 @@ mod_review_config_ui <- function(id){ #' @param id Character string, used to connect the module UI with the module Server. #' @param r Common reactiveValues. Used to pass on filtered data and filtered subjects #' (based on selected sites/regions) to the main server. Expects to contain -#' `r$filtered_data`, `r$filtered_tables`, `r$filtered_subjects` and `r$subject_id` (the ' +#' `r$filtered_data`, `r$filtered_subjects` and `r$subject_id` (the ' #' active/current subject id'). The latter is needed because the `r$subject_id` #' needs to be set to the first ID in the filtered selection to prevent a #' non-selected subject_id to be active. #' @param app_data List of data frames with the app data. -#' @param app_tables List of data frames with the app data in wide table format. #' @param sites A data frame with columns "site_code", with all unique site #' identifiers, and "region", the region of the study site. #' @param subject_ids Character vector containing all subject ids. Used for @@ -49,7 +48,6 @@ mod_review_config_server <- function( id, r, app_data, - app_tables, sites, subject_ids ){ @@ -156,7 +154,7 @@ mod_review_config_server <- function( golem::cat_dev("Selected sites:", modvars$site_selection, "\n") r <- filter_data(r, sites = input$site_selection, subject_ids = subject_ids, - appdata = app_data, apptables = app_tables) + appdata = app_data) r$user_role <- input$active_role shiny::showModal( diff --git a/R/mod_review_config_fct_helpers.R b/R/mod_review_config_fct_helpers.R index eb92dd28..08edb14e 100644 --- a/R/mod_review_config_fct_helpers.R +++ b/R/mod_review_config_fct_helpers.R @@ -7,8 +7,6 @@ #' correct order of subject IDs. #' @param appdata Application data in long format, stored in a list. List #' contains data frames named per form. -#' @param apptables Application data tables in wide format, stored in a list. -#' List contains data frames named per form. #' #' @return A `reactivevalues` object. #' @@ -16,8 +14,7 @@ filter_data <- function( data, sites, subject_ids, - appdata, - apptables + appdata ){ stopifnot(is.reactivevalues(data)) @@ -28,9 +25,6 @@ filter_data <- function( # To ensure the right order of IDs: data$filtered_subjects <- subject_ids[subject_ids %in% filtered_ids] cat("selected subjects: ", data$filtered_subjects, "\n\n") - data$filtered_tables <- lapply(apptables, \(x){ - with(x, x[subject_id %in% data$filtered_subjects, ] ) - }) data$subject_id <- data$filtered_subjects[1] golem::cat_dev("Finished applying review configuration\n\n") data diff --git a/R/mod_review_data_fct_helpers.R b/R/mod_review_data_fct_helpers.R index 2ded1835..a628643e 100644 --- a/R/mod_review_data_fct_helpers.R +++ b/R/mod_review_data_fct_helpers.R @@ -159,12 +159,22 @@ summarize_review_data <- function( collapse_column_vals(column = event_var, exclude = collapse_exclude, group_by = key_cols) |> dplyr::mutate( - "{status_var}" := dplyr::case_when( - all(.data[[status_var]] == "old") ~ "old", - all(.data[[status_var]] %in% c("new", "old")) ~ "new", - all(.data[[status_var]] %in% c("updated", "old")) ~ "updated", - all(.data[[status_var]] %in% c("old", "updated", "new")) ~ "new/updated", - TRUE ~ NA_character_ + "{status_var}" := ifelse( + all(.data[[status_var]] == "old"), + "old", + ifelse( + all(.data[[status_var]] %in% c("new", "old")), + "new", + ifelse( + all(.data[[status_var]] %in% c("updated", "old")), + "updated", + ifelse( + all(.data[[status_var]] %in% c("old", "updated", "new")), + "new/updated", + NA_character_ + ) + ) + ) ), .by = dplyr::all_of(key_cols) ) |> @@ -174,7 +184,7 @@ summarize_review_data <- function( dplyr::mutate( dplyr::across(dplyr::all_of(date_time_vars), ~max(., na.rm = TRUE)), .by = dplyr::all_of(key_cols) - ) |> + ) |> dplyr::distinct() } data diff --git a/R/mod_review_form_tbl.R b/R/mod_review_form_tbl.R index 3ece0e1a..36c373c2 100644 --- a/R/mod_review_form_tbl.R +++ b/R/mod_review_form_tbl.R @@ -5,7 +5,10 @@ #' mod_review_form_tbl_ui <- function(id) { ns <- NS(id) - DT::dataTableOutput(ns("table")) + tagList( + downloadLink(ns("table_download"), character()), + DT::dataTableOutput(ns("table")) + ) } #' Review forms table - Shiny module Server @@ -24,6 +27,12 @@ mod_review_form_tbl_ui <- function(id) { #' @param form_review_data Common reactive value containing the review data of #' the form. #' @param form_items Named character vector with all form_items to display. +#' @param transformation A reactive value. If this is 'none' then the columns +#' `item_value` and `item_unit` will be used in the table. Otherwise, +#' `value_standardized` and `unit_standardized` will be used. +#' @param show_limits Optional reactive value containing a logical. If the +#' logical inside is `TRUE`, laboratory limits will be added to the table +#' shown in the module. #' @param active_subject Reactive value containing the active subject id. #' @param show_all Common reactive value, a logical indicating whether all #' records should be displayed. @@ -32,7 +41,10 @@ mod_review_form_tbl_ui <- function(id) { #' interactive tables. #' @param title An optional character vector. If provided, will be used within #' [datatable_custom()], as the title for the table. -#' +#' @param enable_text_wrap A reactive value, to enable/disable multi-line +#' table rows. Usually disabled so that deferred rendering is possible, but +#' can be enabled for better viewing experience. +#' #' @seealso [mod_review_form_tbl_ui()], [mod_common_forms_ui()], #' [mod_common_forms_server()], [mod_study_forms_ui()], #' [mod_study_forms_server()] @@ -43,8 +55,11 @@ mod_review_form_tbl_server <- function( form_data, form_review_data, form_items, + transformation = NULL, + show_limits = NULL, active_subject, show_all, + enable_text_wrap = reactive(FALSE), table_names = NULL, title = NULL ){ @@ -54,8 +69,11 @@ mod_review_form_tbl_server <- function( stopifnot(is.character(form_items)) stopifnot(is.reactive(active_subject)) stopifnot(is.reactive(show_all)) + stopifnot(is.reactive(enable_text_wrap)) stopifnot(is.character(table_names %||% "")) stopifnot(is.character(title %||% "")) + transformation <- transformation %||% reactiveVal("none") + show_limits <- show_limits %||% reactiveVal(FALSE) moduleServer(id, function(input, output, session){ ns <- session$ns @@ -75,12 +93,14 @@ mod_review_form_tbl_server <- function( form_review_data(), form = form, form_items = form_items, + transformation = transformation() %||% "none", + show_limits = show_limits() %||% FALSE, active_subject = if(identical(session$userData$review_type(), "form")) NULL else active_subject(), pending_form_review_status = NULL, is_SAE = identical(title, "Serious Adverse Events") ) }) |> - bindEvent(form_data(), form_review_data(), active_subject(), session$userData$review_type()) + bindEvent(form_data(), form_review_data(), active_subject(), session$userData$review_type(), transformation(), show_limits()) ############################### Observers: ################################# @@ -91,7 +111,7 @@ mod_review_form_tbl_server <- function( session$userData$pending_form_review_status[[form]] <- NULL session$userData$pending_review_records[[form]] <- data.frame(id = integer(), reviewed = character()) }, priority = 100) |> - bindEvent(active_subject(), form_review_data(), form_data(), session$userData$review_type()) + bindEvent(active_subject(), form_review_data(), form_data(), session$userData$review_type(), transformation(), show_limits()) observeEvent(datatable_rendered(), { golem::cat_dev(form, "| renewing table_data using merged_form_data()\n\n") @@ -134,9 +154,9 @@ mod_review_form_tbl_server <- function( table_data(df) }) - # Any time the data in the form table is updated, "show all" is toggled, - # or the subject being viewed is changed, the server data for the datatable - # needs to be updated + # Triggers when server data needs to be updated. Also triggers for each + # change in pending review records (e.g. a checkbox in column `Reviewed` + # is toggled on or off). observe({ req(!is.null(show_all())) req(table_data(), datatable_rendered()) @@ -147,11 +167,11 @@ mod_review_form_tbl_server <- function( rownames = FALSE, outputId = table_proxy$rawId ) - }) + }) |> + bindEvent(table_data(), show_all(), active_subject(), enable_text_wrap()) - # Any time the review table is updated, "show all" is toggled, or the - # subject being viewed is changed, the datatable should be reloaded to show - # the new data + # For performance reasons, fully reloading table below will not be + # triggered when pending review records are updated (`Reviewed` checkboxes). observeEvent(reload_data(), { req(!is.null(show_all())) req(table_data(), datatable_rendered()) @@ -218,9 +238,36 @@ mod_review_form_tbl_server <- function( visible = isolate(show_all()) )), rowCallback = row_callback - )) + ), + enable_text_wrap = !isFALSE(enable_text_wrap()) + ) }) table_proxy <- DT::dataTableProxy("table") + + output[["table_download"]] <- downloadHandler( + filename = function() { + export_label = paste( + ifelse(identical(title, "Serious Adverse Events"), "SAEs", simplify_string(form)), + ifelse(show_all(), "all_patients", active_subject()), + sep = "." + ) + paste("clinsight", export_label, "csv", sep = ".") + }, + content = function(file) { + readr::write_csv( + table_data() |> + subset(show_all() | subject_id == active_subject()) |> + dplyr::select(-row_review_status) |> + dplyr::rename(dplyr::any_of(table_names)) |> + dplyr::mutate(dplyr::across( + dplyr::where(is.character), + \(x) gsub("|", "", x) + )), + file, + na = "" + ) + } + ) if(form %in% c("Vital signs", "Vitals adjusted")){ shiny::exportTestValues( diff --git a/R/mod_review_form_tbl_fct_helpers.R b/R/mod_review_form_tbl_fct_helpers.R index 246949ac..e64dff5f 100644 --- a/R/mod_review_form_tbl_fct_helpers.R +++ b/R/mod_review_form_tbl_fct_helpers.R @@ -5,6 +5,11 @@ #' @param form_review_data A data frame with he review data of the form. #' @param form A character string with the name of the form. #' @param form_items Named character vector with all form_items to display. +#' @param transformation A character value. If this is 'none' then the columns +#' `item_value` and `item_unit` will be used in the table. Otherwise, +#' `value_standardized` and `unit_standardized` will be used. +#' @param show_limits Logical, indicating whether laboratory limits will be +#' added to the table. #' @param active_subject A character string with the active subject id. #' @param pending_form_review_status A logical, indicating whether all items of #' the entire form for the active subject id are reviewed. Note that the @@ -22,6 +27,8 @@ get_form_table <- function( form_review_data, form, form_items, + transformation = "none", + show_limits = FALSE, active_subject, pending_form_review_status = NULL, is_SAE = NULL, @@ -40,6 +47,11 @@ get_form_table <- function( if(length(missing_cols) != 0){ stop("the following columns are missing: ", paste0(missing_cols, collapse = ", ")) } + value_column <- if (identical(transformation, "none")) "item_value" else "value_standardized" + unit_column <- if (identical(transformation, "none")) "item_unit" else "unit_standardized" + lower_lim_column <- if (identical(transformation, "none")) "lower_lim" else "lower_lim_standardized" + upper_lim_column <- if (identical(transformation, "none")) "upper_lim" else "upper_lim_standardized" + df <- dplyr::left_join( form_data, form_review_data |> @@ -48,14 +60,28 @@ get_form_table <- function( ) |> dplyr::mutate( not_reviewed_but_missing = (reviewed == "No" & is.na(item_value)), - item_value = dplyr::case_when( - is.na(reviewed) ~ htmltools::htmlEscape(item_value), - (reviewed == "No" & !is.na(item_value)) ~ - paste0("", htmltools::htmlEscape(item_value), "*"), - .default = htmltools::htmlEscape(item_value) + "{value_column}" := ifelse( + is.na(reviewed), + htmltools::htmlEscape(.data[[value_column]]), + ifelse( + (reviewed == "No" & !is.na(.data[[value_column]])), + paste0("", htmltools::htmlEscape(.data[[value_column]]), "*"), + htmltools::htmlEscape(.data[[value_column]]) + ) ) ) |> - create_table(expected_columns = names(form_items)) |> + add_limits_to_table( + add_limits = isTRUE(show_limits), + value_column = value_column, + unit_column = unit_column, + lower_lim_column = lower_lim_column, + upper_lim_column = upper_lim_column + ) |> + create_table( + expected_columns = names(form_items), + value_column = value_column, + unit_column = unit_column + ) |> dplyr::mutate( row_review_status = Map( \(x, y, z) append(x, list( @@ -69,6 +95,7 @@ get_form_table <- function( if (is.null(active_subject)) FALSE else subject_id != active_subject ) ) + if(!is.null(active_subject)){ df <- df[order(df$subject_id != active_subject), ] } @@ -78,6 +105,30 @@ get_form_table <- function( df } +add_limits_to_table <- function( + data, + add_limits = FALSE, + value_column = "item_value", + unit_column = "item_unit", + lower_lim_column = "lower_lim", + upper_lim_column = "upper_lim" + ) { + stopifnot(is.data.frame(data)) + if (isFALSE(add_limits)) { + return(data) + } + data |> + dplyr::mutate( + "{value_column}" := paste0( + .data[[value_column]], " (", + ifelse(is.na(.data[[lower_lim_column]]), "?", .data[[lower_lim_column]]), + "-", + ifelse(is.na(.data[[upper_lim_column]]), "?", .data[[upper_lim_column]]), + ")" + ) + ) +} + #' Adjust (Serious) Adverse Event form tables #' #' Needed because AE and SAE items are closely related and are currently diff --git a/R/mod_review_forms.R b/R/mod_review_forms.R index f56bd547..232f0600 100644 --- a/R/mod_review_forms.R +++ b/R/mod_review_forms.R @@ -409,7 +409,7 @@ mod_review_forms_server <- function( split_review_data(db_path)[[active_form()]] }) } - showNotification("Input saved successfully", duration = 1, type = "message") + showNotification("Input saved successfully", duration = 1, type = "message") }) output[["progress_bar"]] <- render_progress_bar({ @@ -430,9 +430,14 @@ mod_review_forms_server <- function( output[["save_review_error"]] <- renderPrint({ validate(need( - role_allowed_to_review(), - paste0("Review not allowed for a '", r$user_role, "'.") - )) + role_allowed_to_review(), { + if (r$user_role == "") { + "No user role assigned. You cannot save a review." + } else { + paste0("With your current role ('", r$user_role, "') you cannot save a review.") + } + } + )) validate(need( review_required(), "Review not required" diff --git a/R/mod_study_forms.R b/R/mod_study_forms.R index ed79f3a5..b3c8d09f 100644 --- a/R/mod_study_forms.R +++ b/R/mod_study_forms.R @@ -49,6 +49,29 @@ mod_study_forms_ui <- function(id, form, form_items){ ), multiple = TRUE ), + bslib::input_switch( + id = ns("show_all_participants"), + label = span(icon("people-group"), "All subjects"), + value = FALSE + ), + conditionalPanel( + condition = "input.show_all_participants === true", + ns = NS(id), + bslib::input_switch( + id = ns("show_all_hover_labels"), + label = span(icon("tags", class = "hover-switch-icon"), "All hover labels"), + value = FALSE + ) + ), + div( + id = ns("transformation_graph_container"), + shinyWidgets::radioGroupButtons( + inputId = ns("transformation_graph"), + label = "Transformation", + choices = c("None" = "none"), + size = "sm" + ) + ), bslib::popover( tags$a("Legend", tags$sup(icon("circle-info")), class = "link"), bslib::card_body(img(src="www/figure_legend.png")) @@ -57,11 +80,30 @@ mod_study_forms_ui <- function(id, form, form_items){ conditionalPanel( condition = "input.switch_view === 'table'", ns = NS(id), - shinyWidgets::materialSwitch( - inputId = ns("show_all"), - label = "Show all participants", - status = "primary", - right = TRUE + bslib::input_switch( + id = ns("show_all"), + label = span(icon("people-group"), "All subjects") + ), + bslib::input_switch( + id = ns("show_limits"), + label = span(icon("arrow-down-up-across-line", class = "limit-switch-icon"), "Lab limits") + ), + div( + id = ns("transformation_table_container"), + shinyWidgets::radioGroupButtons( + inputId = ns("transformation_table"), + label = "Transformation", + choices = c("None" = "none"), + size = "sm" + ) + ), + bslib::input_switch( + id = ns("enable_text_wrap"), + label = span(tags$img(src="www/text-wrap.svg", class = "textwrap-switch-icon"), "Text wrap") + ), + bslib::card_body( + HTML("Bold*: New/updated data"), + fillable = FALSE ) ) ) @@ -122,20 +164,27 @@ mod_study_forms_server <- function( data_types <- isolate(unique(form_data()$item_type)) all_continuous <- (!is.null(data_types) && all(data_types == "continuous") ) - if(!all_continuous){ - shinyWidgets::updateRadioGroupButtons( - inputId = "switch_view", - selected = "table" - ) - shinyjs::disable("switch_view") - } + + observeEvent(input$switch_view, { + if (!all_continuous) { + shinyWidgets::updateRadioGroupButtons(inputId = "switch_view", selected = "table") + shinyjs::disable("switch_view") + } + }, + once = TRUE + ) + observeEvent(input$show_limits, { + if (!all_continuous) shinyjs::hide("show_limits") + }, + once = TRUE + ) observeEvent(session$userData$review_type(), { golem::cat_dev(form, "| Updating tables to show '", session$userData$review_type(), "' level data\n", sep = "") - shinyWidgets::updateMaterialSwitch( + bslib::update_switch( session = session, - inputId = "show_all", + id = "show_all", value = identical(session$userData$review_type(), "form") ) shinyjs::toggleState( @@ -154,6 +203,15 @@ mod_study_forms_server <- function( ) }) + observeEvent(input$show_all, { + req(isTRUE(input$show_all)) + bslib::update_switch( + session = session, + id = "enable_text_wrap", + value = FALSE + ) + }) + fig_data <- reactive({ req(isTRUE(all_continuous)) validate(need( @@ -168,6 +226,41 @@ mod_study_forms_server <- function( }) |> debounce(1000) + cols <- c("item_scale", "use_unscaled_limits") + # Ensure no errors even if cols are missing, with FALSE as default: + scaling_data <- lapply(add_missing_columns(item_info, cols)[1, cols], isTRUE) + + observeEvent(form_data(), { + has_standardized <- any(!is.na(form_data()[["value_standardized"]])) + has_scaled <- isTRUE(scaling_data$item_scale) && any(!is.na(form_data()[["value_scaled"]])) + + data_types_table <- c("None" = "none", if (has_standardized) c("Standardized" = "standardized")) + data_types_graph <- c(data_types_table, if (has_scaled) c("Scaled" = "scaled")) + + if (length(data_types_table) == 1L) { + removeUI(selector = paste0("#", ns("transformation_table_container"))) + } else { + shinyWidgets::updateRadioGroupButtons( + session = session, + inputId = "transformation_table", + choices = data_types_table + ) + } + + if (length(data_types_graph) == 1L) { + removeUI(selector = paste0("#", ns("transformation_graph_container"))) + } else { + shinyWidgets::updateRadioGroupButtons( + session = session, + inputId = "transformation_graph", + choices = data_types_graph, + selected = if (has_scaled) "scaled" else "none" + ) + } + }, + once = TRUE + ) + mod_review_form_tbl_server( "review_form_tbl", form = form, @@ -175,27 +268,27 @@ mod_study_forms_server <- function( form_review_data = form_review_data, active_subject = active_subject, form_items = form_items, + transformation = reactive(input$transformation_table %||% "none"), show_all = reactive(isTRUE(input$show_all) | identical(session$userData$review_type(), "form")), + enable_text_wrap = reactive(isTRUE(input$enable_text_wrap)), + show_limits = reactive(isTRUE(input$show_limits)), table_names = table_names, title = form ) - - scaling_data <- reactive({ - cols <- c("item_scale", "use_unscaled_limits") - # Ensure no errors even if cols are missing, with FALSE as default: - lapply(add_missing_columns(item_info, cols)[1, cols], isTRUE) - }) ############################### Outputs: ################################### dynamic_figure <- reactive({ - req(nrow(fig_data()) > 0, scaling_data()) - scale_yval <- scaling_data()$item_scale - yval <- ifelse(scale_yval, "value_scaled", "item_value") + req(nrow(fig_data()) > 0, scaling_data) + yval <- switch( + input$transformation_graph %||% "none", + "scaled" = "value_scaled", + "none" = "item_value", + "standardized" = "value_standardized", + "item_value" + ) validate(need( fig_data()[[yval]], - ifelse(scale_yval, - "No non-missing scaled data available. Check table view.", - "No non-missing data available.") + "No non-missing data available. Check table view or non-transformed data." )) plotly_figure( data = fig_data(), @@ -205,8 +298,11 @@ mod_study_forms_server <- function( id_to_highlight = active_subject(), point_size = "reviewed", height = ceiling(0.5*length(unique(fig_data()$item_name))*125+175), - scale = scale_yval, - use_unscaled_limits = scaling_data()$use_unscaled_limits + show_all_participants = isTRUE(input$show_all_participants), + show_all_hover_labels = input$show_all_hover_labels, + label = if (yval == "value_standardized") "label_standardized" else "text_label", + yval = yval, + use_unscaled_limits = scaling_data$use_unscaled_limits ) }) @@ -222,8 +318,3 @@ mod_study_forms_server <- function( }) } -## To be copied in the UI -# mod_study_forms_ui("study_form_element_1") - -## To be copied in the server -# mod_study_forms_server("study_form_element_1") diff --git a/R/mod_timeline.R b/R/mod_timeline.R index 2ac27952..b6fd4aa7 100644 --- a/R/mod_timeline.R +++ b/R/mod_timeline.R @@ -19,10 +19,11 @@ mod_timeline_ui <- function(id){ #' #' @param id Character string, used to connect the module UI with the module #' Server. +#' @inheritParams mod_header_widgets_server #' @inheritParams mod_common_forms_server #' -#' @seealso [mod_timeline_ui()], [mod_common_forms_ui()], -#' [mod_common_forms_server()] +#' @seealso [mod_timeline_ui()], [mod_header_widgets_ui()], +#' [mod_header_widgets_server()] mod_timeline_server <- function( id, form_review_data, @@ -31,7 +32,7 @@ mod_timeline_server <- function( ){ stopifnot( is.reactive(form_review_data), - is.reactive(timeline_data), + is.data.frame(timeline_data), is.reactive(active_subject) ) @@ -39,14 +40,18 @@ mod_timeline_server <- function( ns <- session$ns timeline_data_active <- reactive({ - review_active <- form_review_data()[form_review_data()$subject_id == active_subject(), ] |> - dplyr::mutate( - needs_review = any(reviewed == "No"), - .by = c(form_repeat, item_group) - ) |> - dplyr::distinct(subject_id, form_repeat, item_group, needs_review) + review_active <- if (is.null(form_review_data())) { + data.frame(subject_id = character(), form_repeat = integer(), item_group = character(), needs_review = character()) + } else { + form_review_data()[form_review_data()$subject_id == active_subject(), ] |> + dplyr::mutate( + needs_review = any(reviewed == "No"), + .by = c(form_repeat, item_group) + ) |> + dplyr::distinct(subject_id, form_repeat, item_group, needs_review) + } - df <- with(timeline_data(), timeline_data()[subject_id == active_subject(), ]) |> + df <- with(timeline_data, timeline_data[subject_id == active_subject(), ]) |> dplyr::left_join(review_active, by = c("subject_id", "form_repeat", "item_group")) |> dplyr::mutate( className = ifelse( @@ -57,7 +62,7 @@ mod_timeline_server <- function( ) df }) |> - bindEvent(form_review_data(), timeline_data(), active_subject()) + bindEvent(form_review_data(), timeline_data, active_subject()) observeEvent(input$timeline_selected, { timevis::centerItem("timeline", input$timeline_selected) diff --git a/inst/app/www/custom.css b/inst/app/www/custom.css index c0fd290c..d01abf54 100644 --- a/inst/app/www/custom.css +++ b/inst/app/www/custom.css @@ -9,6 +9,22 @@ float: right; } +.hover-switch-icon { + padding-right: 4px; +} + +.limit-switch-icon { + padding-right: 2px; +} + +.textwrap-switch-icon { + padding-right: 4px; +} + +.sae_table_custom { + padding-bottom: 2.5rem; +} + .bslib-value-box .value-box-area { padding: 0.1rem 0rem 0.1rem 1rem; } @@ -37,6 +53,7 @@ padding-right: 0rem; padding-bottom: 0rem; padding-left: 0rem; + cursor: default; } /* below is needed for good alignment of the top-widgets */ @@ -52,7 +69,8 @@ .top-widgets-custom { display:flex; flex-direction: column; - padding-bottom: 0rem; + padding-bottom: 0rem; + cursor: pointer; /* overflow-x: scroll; padding-top: 1rem; padding-right: 1rem; @@ -155,3 +173,11 @@ div.cs-progress-container>.cs-progress-bar>.cs-progress.marking { .bslib-sidebar-layout .sidebar .sidebar-content{ height: 100%; } + +span.cs-span-overflow { + text-overflow: ellipsis; + overflow: hidden; + display: -webkit-box; + -webkit-line-clamp: 6; + -webkit-box-orient: vertical; +} diff --git a/inst/app/www/custom.js b/inst/app/www/custom.js index 2c1ac3a7..1112491f 100644 --- a/inst/app/www/custom.js +++ b/inst/app/www/custom.js @@ -171,3 +171,12 @@ $(document).ready(function() { Shiny.outputBindings.register(customProgressBar) }); + +function hiddenDownloadHandlerTrigger( e, dt, node, config ) { + const tblId = dt.tables().nodes().to$().closest('.datatables').attr('id'); + + document.getElementById(tblId + '_download').click() + + return; + e; +} diff --git a/inst/app/www/text-wrap.svg b/inst/app/www/text-wrap.svg new file mode 100644 index 00000000..4c732d6c --- /dev/null +++ b/inst/app/www/text-wrap.svg @@ -0,0 +1,3 @@ + + + \ No newline at end of file diff --git a/inst/golem-config.yml b/inst/golem-config.yml index 8f89bb26..373abec1 100644 --- a/inst/golem-config.yml +++ b/inst/golem-config.yml @@ -1,6 +1,6 @@ default: golem_name: clinsight - golem_version: 0.3.0 + golem_version: 0.4.0 app_prod: no user_identification: test_user study_data: !expr clinsight::clinsightful_data @@ -11,6 +11,7 @@ default: Medical Monitor: medical_monitor Data Manager: data_manager allow_to_review: [admin, medical_monitor] + allow_to_query: [admin, medical_monitor] allow_listing_download: TRUE allow_query_inputs: TRUE study_logo: assets/study_logo.png @@ -31,6 +32,9 @@ shinyproxy: study_data: study_data/study_data.rds meta_data: study_data/metadata.rds user_db: study_data/user_db.sqlite + study_logo: study_data/assets/study_logo.png + allow_to_review: [medical_monitor] + allow_to_query: [medical_monitor] posit_connect: app_prod: yes user_identification: shiny_session diff --git a/man/add_text_label.Rd b/man/add_text_label.Rd new file mode 100644 index 00000000..68eb504a --- /dev/null +++ b/man/add_text_label.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fct_appdata.R +\name{add_text_label} +\alias{add_text_label} +\title{Add text label} +\usage{ +add_text_label( + data, + label_name = "text_label", + value = "item_value", + item_unit = "item_unit", + lower_lim = "lower_lim", + upper_lim = "upper_lim", + subject_id = "subject_id", + event_date = "event_date", + event_name = "event_name", + day = "day", + significance = "significance" +) +} +\arguments{ +\item{data}{} +} +\description{ +Helper function for \code{\link[=get_appdata]{get_appdata()}}. +} +\keyword{internal} diff --git a/man/clinsight-package.Rd b/man/clinsight-package.Rd index 8e44d9d1..5499c2ab 100644 --- a/man/clinsight-package.Rd +++ b/man/clinsight-package.Rd @@ -22,10 +22,14 @@ Useful links: \author{ \strong{Maintainer}: Leonard DaniĆ«l Samson \email{lsamson@gcp-service.com} (\href{https://orcid.org/0000-0002-6252-7639}{ORCID}) +Authors: +\itemize{ + \item Aaron Clark \email{aclark02@arcusbio.com} (\href{https://orcid.org/0000-0002-0123-0970}{ORCID}) + \item Jeff Thompson \email{jthompson@arcusbio.com} (\href{https://orcid.org/0009-0007-3640-1075}{ORCID}) +} + Other contributors: \itemize{ - \item Aaron Clark \email{aclark02@arcusbio.com} (\href{https://orcid.org/0000-0002-0123-0970}{ORCID}) [contributor] - \item Jeff Thompson \email{jthompson@arcusbio.com} (\href{https://orcid.org/0009-0007-3640-1075}{ORCID}) [contributor] \item GCP-Service International Ltd.& Co. KG [funder] } diff --git a/man/count_adverse_events.Rd b/man/count_adverse_events.Rd new file mode 100644 index 00000000..a396d52e --- /dev/null +++ b/man/count_adverse_events.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mod_header_widgets_fct_helpers.R +\name{count_adverse_events} +\alias{count_adverse_events} +\title{Count Adverse Events} +\usage{ +count_adverse_events( + data, + all_ids = NULL, + SAE_column_name = "Serious Adverse Event" +) +} +\arguments{ +\item{data}{A data frame with Adverse Event data. Required columns are the +clinsight \code{key_cols} and the column \code{item_value}.} +} +\value{ +A data frame with the columns \code{subject_id}, \code{AEs} (number of AEs per +subject), \code{SAEs} (number of SAEs per subject). +} +\description{ +Simple helper function to count Adverse Events (AEs) and Serious Adverse +Events (SAEs). +} +\keyword{internal} diff --git a/man/datatable_custom.Rd b/man/datatable_custom.Rd index 2635d8d1..95f50714 100644 --- a/man/datatable_custom.Rd +++ b/man/datatable_custom.Rd @@ -14,6 +14,8 @@ datatable_custom( options = list(), allow_listing_download = NULL, export_label = NULL, + escape = TRUE, + enable_text_wrap = FALSE, ... ) } @@ -60,6 +62,12 @@ needed.} \item{export_label}{Character string with the table export label. Only used for downloadable tables (if \code{allow_listing_download} is \code{TRUE}).} +\item{escape}{Whether to escape HTML entities in the table. See +\code{\link[DT:datatable]{DT::datatable()}}.} + +\item{enable_text_wrap}{Logical, whether to enable text wrapping in the +table. If TRUE, pagination will be used and \code{deferRender} disabled.} + \item{...}{Other optional arguments that will be passed to \code{\link[DT:datatable]{DT::datatable()}}.} } \value{ diff --git a/man/fig_timeseries.Rd b/man/fig_timeseries.Rd index 52c722ca..06f434c8 100644 --- a/man/fig_timeseries.Rd +++ b/man/fig_timeseries.Rd @@ -12,7 +12,9 @@ fig_timeseries( color_fill = "significance", point_size = "reviewed", label = "text_label", - scale = FALSE, + show_all_participants = TRUE, + show_all_hover_labels = FALSE, + yval = "item_value", use_unscaled_limits = FALSE ) } @@ -36,8 +38,12 @@ the point size in the figure.} only be visible if the ggplot object is converted to an interactive plot using \code{plotly::ggplotly()}. See \code{\link[=plotly_figure]{plotly_figure()}}} -\item{scale}{A logical. Whether to us a scaled value (value_scaled) or the -raw variable (item_value).} +\item{show_all_participants}{Logical to toggle background patterns.} + +\item{show_all_hover_labels}{Logical to toggle hover labels.} + +\item{yval}{Character vector with the column name with the values. Must be +numeric.} \item{use_unscaled_limits}{If TRUE, limits provided in the data frame will be used. This parameter will be ignored if scaled is set to \code{TRUE}.} @@ -59,9 +65,9 @@ mock_data <- lapply(paste0("Subject", 1:10) , \(x){ item_name = sample(c("item1", "item2"), 10, replace = TRUE), item_value = runif(10, 0 , 50), significance = sample( - c("limits unknown", "out of limits, clinically significant", - "out of limits, clinically insignificant"), - 10, + c("limits unknown", "out of limits, clinically significant", + "out of limits, clinically insignificant"), + 10, replace = TRUE ), text_label = "test text", diff --git a/man/figures/README-fig_timeseries.png b/man/figures/README-fig_timeseries.png index 54a07b6f..13269efd 100644 Binary files a/man/figures/README-fig_timeseries.png and b/man/figures/README-fig_timeseries.png differ diff --git a/man/figures/README-timeline.png b/man/figures/README-timeline.png index 9575a8c2..5d81f351 100644 Binary files a/man/figures/README-timeline.png and b/man/figures/README-timeline.png differ diff --git a/man/filter_data.Rd b/man/filter_data.Rd index 16792128..89e0f676 100644 --- a/man/filter_data.Rd +++ b/man/filter_data.Rd @@ -4,7 +4,7 @@ \alias{filter_data} \title{Filter app data} \usage{ -filter_data(data, sites, subject_ids, appdata, apptables) +filter_data(data, sites, subject_ids, appdata) } \arguments{ \item{data}{A \code{Reactivevalues} object. filtered data will be written into @@ -17,9 +17,6 @@ correct order of subject IDs.} \item{appdata}{Application data in long format, stored in a list. List contains data frames named per form.} - -\item{apptables}{Application data tables in wide format, stored in a list. -List contains data frames named per form.} } \value{ A \code{reactivevalues} object. diff --git a/man/get_available_data.Rd b/man/get_available_data.Rd index 15cdaf2c..ceecde4a 100644 --- a/man/get_available_data.Rd +++ b/man/get_available_data.Rd @@ -4,19 +4,12 @@ \alias{get_available_data} \title{Get available data} \usage{ -get_available_data(data, tables, all_forms, form_repeat_name = "N") +get_available_data(data, form_repeat_name = "N") } \arguments{ \item{data}{list of data frames to be used. Will be used for extracting the variables of interest from the study-specific forms.} -\item{tables}{list of tables to be used. Will be used for extracting the -variables of interest from the common forms.} - -\item{all_forms}{A data frame containing all forms. Mandatory columns are -"form" (containing the form names), and "main_tab" (containing the tab name -where the form should be located).} - \item{form_repeat_name}{A character string with the name of the \code{form_repeat} variable. This variable (with this name) will be added to the item name if duplicate names exist for each participant.} diff --git a/man/get_form_table.Rd b/man/get_form_table.Rd index dc60d3fb..ddc5b3f4 100644 --- a/man/get_form_table.Rd +++ b/man/get_form_table.Rd @@ -9,6 +9,8 @@ get_form_table( form_review_data, form, form_items, + transformation = "none", + show_limits = FALSE, active_subject, pending_form_review_status = NULL, is_SAE = NULL, @@ -24,6 +26,13 @@ get_form_table( \item{form_items}{Named character vector with all form_items to display.} +\item{transformation}{A character value. If this is 'none' then the columns +\code{item_value} and \code{item_unit} will be used in the table. Otherwise, +\code{value_standardized} and \code{unit_standardized} will be used.} + +\item{show_limits}{Logical, indicating whether laboratory limits will be +added to the table.} + \item{active_subject}{A character string with the active subject id.} \item{pending_form_review_status}{A logical, indicating whether all items of diff --git a/man/get_static_overview_data.Rd b/man/get_static_overview_data.Rd index d985a2b9..908dbe3d 100644 --- a/man/get_static_overview_data.Rd +++ b/man/get_static_overview_data.Rd @@ -4,19 +4,24 @@ \alias{get_static_overview_data} \title{Create static overview data} \usage{ -get_static_overview_data(data, expected_general_columns = NULL) +get_static_overview_data(data, available_data, expected_general_columns = NULL) } \arguments{ \item{data}{List of data frames.} +\item{available_data}{A data frame with available data. Visits will be +extracted from here. Required columns are \code{subject_id}, \code{event_name}, +\code{event_label}. The \code{event_label} variable should be a factor in order to +work well with the function \code{\link[=fig_timeline]{fig_timeline()}}.} + \item{expected_general_columns}{Character vector with the expected columns. If columns are completely missing, they will be made explicitly missing in -the data frame (that is, a column will be created with only missing character -values).} +the data frame (that is, a column will be created with only missing +character values).} } \value{ -A data frame with the overview data. Columns are: -\code{subject_id}, \code{status}, \code{WHO.classification}, \code{Age}, \code{Sex}, \code{event_name}. +A data frame with the overview data. Columns are: \code{subject_id}, +\code{status}, \code{WHO.classification}, \code{Age}, \code{Sex}, \code{event_name}. } \description{ Creates overview data of each patient in the study. Used to create the start diff --git a/man/get_timeline_data.Rd b/man/get_timeline_data.Rd index 2dfa34de..161567c4 100644 --- a/man/get_timeline_data.Rd +++ b/man/get_timeline_data.Rd @@ -6,7 +6,10 @@ \usage{ get_timeline_data( data, - table_data, + available_data = NULL, + expected_ae_cols = c("AE Name", "Serious Adverse Event", "AE start date", + "AE end date", "SAE Start date", "SAE End date", "AE date of worsening", + "CTCAE severity worsening"), timeline_cols = c("subject_id", "event_name", "form_repeat", "item_group", "start", "group", "end", "title", "className", "id", "order"), treatment_label = "šŸ’Š Tā‚“" @@ -15,8 +18,13 @@ get_timeline_data( \arguments{ \item{data}{A list of data frames, with compatible clinical trial data.} -\item{table_data}{A list of data frames containing clinical trial data in -wide format. Created with \code{\link[=create_table]{create_table()}}.} +\item{available_data}{Optional, data frame with all available data gathered. +Used to extract visit information. If not provided, this data frame will be +created internally by running \code{\link[=get_available_data]{get_available_data()}} on the provided \code{data} +list.} + +\item{expected_ae_cols}{Character vector with expected columns for the +adverse event table within the \code{data} list.} \item{timeline_cols}{Character vector with the name of the columns of the output data frame.} diff --git a/man/mod_common_forms_server.Rd b/man/mod_common_forms_server.Rd index 1efda4b8..e68bd1f2 100644 --- a/man/mod_common_forms_server.Rd +++ b/man/mod_common_forms_server.Rd @@ -12,8 +12,7 @@ mod_common_forms_server( form_items, active_subject, id_item = c("subject_id", "event_name", "item_group", "form_repeat", "item_name"), - table_names = NULL, - timeline_data + table_names = NULL ) } \arguments{ @@ -46,10 +45,6 @@ that can uniquely identify one item/row.} \item{table_names}{An optional character vector. If provided, will be used within \code{\link[=datatable_custom]{datatable_custom()}}, to improve the column names in the final interactive tables.} - -\item{timeline_data}{A reactive with a data frame containing the timeline -data. Used to create the timeline figure. Created with -\code{\link[=get_timeline_data]{get_timeline_data()}}.} } \description{ Shiny module. Used to display common form data in the dedicated tab. @@ -61,11 +56,7 @@ common forms are currently: \verb{Adverse events}, \verb{Medical History}, changed in the metadata. The tables shown are overview tables in wide format, similar to the ones in \code{\link[=mod_study_forms_server]{mod_study_forms_server()}}. When the common form \verb{Adverse events} is selected, the module will show an additional table with -Severe Adverse Events above the table with Adverse Events. In addition, it -will show a timeline by calling module -\code{\link[=mod_timeline_ui]{mod_timeline_ui()}}/\code{\link[=mod_timeline_server]{mod_timeline_server()}}. The timeline shows study events -(such as drug administrations) and study visits together with Adverse Events, -so that temporal relationships between these events can be quickly revealed. +Severe Adverse Events above the table with Adverse Events. The \verb{common forms} module is used in the main server to create all applicable common form pages. } diff --git a/man/mod_common_forms_ui.Rd b/man/mod_common_forms_ui.Rd index 51ef26ba..e263c63e 100644 --- a/man/mod_common_forms_ui.Rd +++ b/man/mod_common_forms_ui.Rd @@ -22,11 +22,7 @@ common forms are currently: \verb{Adverse events}, \verb{Medical History}, changed in the metadata. The tables shown are overview tables in wide format, similar to the ones in \code{\link[=mod_study_forms_server]{mod_study_forms_server()}}. When the common form \verb{Adverse events} is selected, the module will show an additional table with -Severe Adverse Events above the table with Adverse Events. In addition, it -will show a timeline by calling module -\code{\link[=mod_timeline_ui]{mod_timeline_ui()}}/\code{\link[=mod_timeline_server]{mod_timeline_server()}}. The timeline shows study events -(such as drug administrations) and study visits together with Adverse Events, -so that temporal relationships between these events can be quickly revealed. +Severe Adverse Events above the table with Adverse Events. The \verb{common forms} module is used in the main server to create all applicable common form pages. } diff --git a/man/mod_go_to_form_server.Rd b/man/mod_go_to_form_server.Rd index 6cc9c16b..9772aca8 100644 --- a/man/mod_go_to_form_server.Rd +++ b/man/mod_go_to_form_server.Rd @@ -11,7 +11,7 @@ mod_go_to_form_server( navtable, tablerow, all_forms, - form_name = "Form", + form_name = "item_group", subject_id = "subject_id" ) } diff --git a/man/mod_header_widgets_server.Rd b/man/mod_header_widgets_server.Rd index d3f05b9c..cd92a127 100644 --- a/man/mod_header_widgets_server.Rd +++ b/man/mod_header_widgets_server.Rd @@ -4,7 +4,14 @@ \alias{mod_header_widgets_server} \title{Header widgets - Shiny module Server} \usage{ -mod_header_widgets_server(id, r, rev_data, navinfo) +mod_header_widgets_server( + id, + r, + rev_data, + navinfo, + timeline_data, + available_data +) } \arguments{ \item{id}{Character string, used to connect the module UI with the module @@ -17,6 +24,13 @@ Server.} \item{navinfo}{Reactive values created with \code{\link[shiny:reactiveValues]{shiny::reactiveValues()}}. Used to send back information about the page change to the server, when clicking on the adverse event box.} + +\item{timeline_data}{A reactive with a data frame containing the timeline +data. Used to create the timeline figure. Created with +\code{\link[=get_timeline_data]{get_timeline_data()}}.} + +\item{available_data}{A data frame containing all available data, usually +created with the function \code{\link[=get_available_data]{get_available_data()}}.} } \description{ A shiny module. Used to show user information of the active user in value diff --git a/man/mod_main_sidebar_server.Rd b/man/mod_main_sidebar_server.Rd index c279c361..ce0cc97d 100644 --- a/man/mod_main_sidebar_server.Rd +++ b/man/mod_main_sidebar_server.Rd @@ -9,7 +9,6 @@ mod_main_sidebar_server( r, navinfo, app_data, - app_tables, app_vars, db_path, forms_to_review, @@ -39,9 +38,6 @@ example, \code{Start} (start page), or \code{Queries}.} of each form stored in a data frame. Required to set the review configuration in \code{\link[=mod_review_config_server]{mod_review_config_server()}}.} -\item{app_tables}{List of data frames with the app data in wide table format. -Required to set the review configuration in \code{\link[=mod_review_config_server]{mod_review_config_server()}}} - \item{app_vars}{A list with common variables found in the data and metadata. Required to set the review configuration in \code{\link[=mod_review_config_server]{mod_review_config_server()}}.} diff --git a/man/mod_navigate_participants_server.Rd b/man/mod_navigate_participants_server.Rd index 3bd57441..4edc5002 100644 --- a/man/mod_navigate_participants_server.Rd +++ b/man/mod_navigate_participants_server.Rd @@ -4,25 +4,28 @@ \alias{mod_navigate_participants_server} \title{Navigate participants - Shiny module Server} \usage{ -mod_navigate_participants_server(id, r) +mod_navigate_participants_server(id, r, static_overview_data = NULL) } \arguments{ -\item{id}{Character string, used to connect the module UI with the module Server.} +\item{id}{Character string, used to connect the module UI with the module +Server.} \item{r}{Common \code{reactiveValues}. Used to access \code{filtered_tables$General}, -containing a data frame with general data to be displayed in the participant -selection modal. -In addition, it will be used to access the list of \code{filtered_subjects} -(character vector), and the currently active \code{subject_id} (character string). -The only parameter that the module will change, if requested by the user, -is \code{subject_id}.} +containing a data frame with general data to be displayed in the +participant selection modal. In addition, it will be used to access the +list of \code{filtered_subjects} (character vector), and the currently active +\code{subject_id} (character string). The only parameter that the module will +change, if requested by the user, is \code{subject_id}.} + +\item{static_overview_data}{Data frame created with +\code{\link[=get_static_overview_data]{get_static_overview_data()}}.} } \description{ A \code{shiny} module. Used to show participant information in a \code{\link[bslib:value_box]{bslib::value_box()}}. By clicking on the \code{\link[bslib:value_box]{bslib::value_box()}}, additional participant information will be shown, as well as a selection menu to select -a different subject. Once the subject is changed, the active \code{subject_id} will -be changed in the application. +a different subject. Once the subject is changed, the active \code{subject_id} +will be changed in the application. } \seealso{ \code{\link[=mod_navigate_participants_ui]{mod_navigate_participants_ui()}} for the UI function diff --git a/man/mod_navigate_participants_ui.Rd b/man/mod_navigate_participants_ui.Rd index aac01130..46e807d8 100644 --- a/man/mod_navigate_participants_ui.Rd +++ b/man/mod_navigate_participants_ui.Rd @@ -7,14 +7,15 @@ mod_navigate_participants_ui(id) } \arguments{ -\item{id}{Character string, used to connect the module UI with the module Server.} +\item{id}{Character string, used to connect the module UI with the module +Server.} } \description{ A \code{shiny} module. Used to show participant information in a \code{\link[bslib:value_box]{bslib::value_box()}}. By clicking on the \code{\link[bslib:value_box]{bslib::value_box()}}, additional participant information will be shown, as well as a selection menu to select -a different subject. Once the subject is changed, the active \code{subject_id} will -be changed in the application. +a different subject. Once the subject is changed, the active \code{subject_id} +will be changed in the application. } \seealso{ \code{\link[=mod_navigate_participants_server]{mod_navigate_participants_server()}} for the server function. diff --git a/man/mod_review_config_server.Rd b/man/mod_review_config_server.Rd index 060dda3a..23114e55 100644 --- a/man/mod_review_config_server.Rd +++ b/man/mod_review_config_server.Rd @@ -4,22 +4,20 @@ \alias{mod_review_config_server} \title{Review configuration - Shiny module Server} \usage{ -mod_review_config_server(id, r, app_data, app_tables, sites, subject_ids) +mod_review_config_server(id, r, app_data, sites, subject_ids) } \arguments{ \item{id}{Character string, used to connect the module UI with the module Server.} \item{r}{Common reactiveValues. Used to pass on filtered data and filtered subjects (based on selected sites/regions) to the main server. Expects to contain -\code{r$filtered_data}, \code{r$filtered_tables}, \code{r$filtered_subjects} and \code{r$subject_id} (the ' +\code{r$filtered_data}, \code{r$filtered_subjects} and \code{r$subject_id} (the ' active/current subject id'). The latter is needed because the \code{r$subject_id} needs to be set to the first ID in the filtered selection to prevent a non-selected subject_id to be active.} \item{app_data}{List of data frames with the app data.} -\item{app_tables}{List of data frames with the app data in wide table format.} - \item{sites}{A data frame with columns "site_code", with all unique site identifiers, and "region", the region of the study site.} diff --git a/man/mod_review_form_tbl_server.Rd b/man/mod_review_form_tbl_server.Rd index dc909347..c3f06a5f 100644 --- a/man/mod_review_form_tbl_server.Rd +++ b/man/mod_review_form_tbl_server.Rd @@ -10,8 +10,11 @@ mod_review_form_tbl_server( form_data, form_review_data, form_items, + transformation = NULL, + show_limits = NULL, active_subject, show_all, + enable_text_wrap = reactive(FALSE), table_names = NULL, title = NULL ) @@ -30,11 +33,23 @@ the form.} \item{form_items}{Named character vector with all form_items to display.} +\item{transformation}{A reactive value. If this is 'none' then the columns +\code{item_value} and \code{item_unit} will be used in the table. Otherwise, +\code{value_standardized} and \code{unit_standardized} will be used.} + +\item{show_limits}{Optional reactive value containing a logical. If the +logical inside is \code{TRUE}, laboratory limits will be added to the table +shown in the module.} + \item{active_subject}{Reactive value containing the active subject id.} \item{show_all}{Common reactive value, a logical indicating whether all records should be displayed.} +\item{enable_text_wrap}{A reactive value, to enable/disable multi-line +table rows. Usually disabled so that deferred rendering is possible, but +can be enabled for better viewing experience.} + \item{table_names}{An optional character vector. If provided, will be used within \code{\link[=datatable_custom]{datatable_custom()}}, to improve the column names in the final interactive tables.} diff --git a/man/mod_study_forms_ui.Rd b/man/mod_study_forms_ui.Rd index 8df51861..87302a20 100644 --- a/man/mod_study_forms_ui.Rd +++ b/man/mod_study_forms_ui.Rd @@ -32,11 +32,7 @@ common forms are currently: \verb{Adverse events}, \verb{Medical History}, changed in the metadata. The tables shown are overview tables in wide format, similar to the ones in \code{\link[=mod_study_forms_server]{mod_study_forms_server()}}. When the common form \verb{Adverse events} is selected, the module will show an additional table with -Severe Adverse Events above the table with Adverse Events. In addition, it -will show a timeline by calling module -\code{\link[=mod_timeline_ui]{mod_timeline_ui()}}/\code{\link[=mod_timeline_server]{mod_timeline_server()}}. The timeline shows study events -(such as drug administrations) and study visits together with Adverse Events, -so that temporal relationships between these events can be quickly revealed. +Severe Adverse Events above the table with Adverse Events. The \verb{common forms} module is used in the main server to create all applicable common form pages. } diff --git a/man/mod_timeline_server.Rd b/man/mod_timeline_server.Rd index 8a8738b6..d1daa750 100644 --- a/man/mod_timeline_server.Rd +++ b/man/mod_timeline_server.Rd @@ -26,6 +26,6 @@ as Investigational Product administration. Helpful to judge whether for example an event is related to an Investigational Product. } \seealso{ -\code{\link[=mod_timeline_ui]{mod_timeline_ui()}}, \code{\link[=mod_common_forms_ui]{mod_common_forms_ui()}}, -\code{\link[=mod_common_forms_server]{mod_common_forms_server()}} +\code{\link[=mod_timeline_ui]{mod_timeline_ui()}}, \code{\link[=mod_header_widgets_ui]{mod_header_widgets_ui()}}, +\code{\link[=mod_header_widgets_server]{mod_header_widgets_server()}} } diff --git a/man/mod_timeline_ui.Rd b/man/mod_timeline_ui.Rd index e333948a..a6b65157 100644 --- a/man/mod_timeline_ui.Rd +++ b/man/mod_timeline_ui.Rd @@ -17,6 +17,6 @@ as Investigational Product administration. Helpful to judge whether for example an event is related to an Investigational Product. } \seealso{ -\code{\link[=mod_timeline_ui]{mod_timeline_ui()}}, \code{\link[=mod_common_forms_ui]{mod_common_forms_ui()}}, -\code{\link[=mod_common_forms_server]{mod_common_forms_server()}} +\code{\link[=mod_timeline_ui]{mod_timeline_ui()}}, \code{\link[=mod_header_widgets_ui]{mod_header_widgets_ui()}}, +\code{\link[=mod_header_widgets_server]{mod_header_widgets_server()}} } diff --git a/tests/testthat/_snaps/app_feature_01/app-feature-1-001.json b/tests/testthat/_snaps/app_feature_01/app-feature-1-001.json index aeb5de72..46c4eef6 100644 --- a/tests/testthat/_snaps/app_feature_01/app-feature-1-001.json +++ b/tests/testthat/_snaps/app_feature_01/app-feature-1-001.json @@ -83,6 +83,96 @@ } ] }, + "header_widgets_1-timeline_fig-timeline": { + "x": { + "items": [ + { + "subject_id": "BEL_08_45", + "content": "Screening", + "start": "2023-06-05", + "group": "Visit", + "title": "2023-06-05 | Screening", + "className": "bg-light", + "id": "18", + "order": "4" + }, + { + "subject_id": "BEL_08_45", + "content": "Exit", + "start": "2023-09-11", + "group": "Visit", + "title": "2023-09-11 | Exit", + "className": "bg-light", + "id": "69", + "order": "4" + } + ], + "groups": [ + { + "id": "Visit", + "content": "Visit", + "order": "4" + } + ], + "showZoom": true, + "zoomFactor": 0.5, + "fit": true, + "options": { + "zoomable": false + }, + "height": null, + "timezone": null, + "api": [ + + ] + }, + "evals": [ + + ], + "jsHooks": { + "render": [ + { + "code": "timelineRedrawCustom", + "data": null + } + ] + }, + "deps": [ + { + "name": "jquery", + "version": "3.6.0", + "src": { + "href": "jquery-3.6.0" + }, + "meta": null, + "script": "jquery-3.6.0.min.js", + "stylesheet": null, + "head": null, + "attachment": null, + "all_files": true + }, + { + "name": "bootstrap", + "version": "3.3.5", + "src": { + "href": "bootstrap-3.3.5" + }, + "meta": { + "viewport": "width=device-width, initial-scale=1" + }, + "script": [ + "js/bootstrap.min.js", + "shim/html5shiv.min.js", + "shim/respond.min.js" + ], + "stylesheet": "css/bootstrap.min.css", + "head": "