diff --git a/DESCRIPTION b/DESCRIPTION index f1285b07..c8948ee8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: clinsight Title: ClinSight -Version: 0.3.0.9006 +Version: 0.3.0.9007 Authors@R: c( person("Leonard Daniël", "Samson", , "lsamson@gcp-service.com", role = c("cre", "aut"), comment = c(ORCID = "0000-0002-6252-7639")), diff --git a/NEWS.md b/NEWS.md index e0bc8402..5d3eeaf8 100644 --- a/NEWS.md +++ b/NEWS.md @@ -16,6 +16,7 @@ ## 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 applcation, improving start up efficiency (#251). # clinsight 0.3.0 diff --git a/R/app_server.R b/R/app_server.R index 5ccd6406..b3e278cd 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] ) @@ -116,7 +118,7 @@ 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( @@ -125,6 +127,7 @@ app_server <- function( trigger_page_change = 1 ) + start_page_summary_vars <- c("subject_status", "WHO.classification", "Age", "Sex", "event_name") rev_data <- reactiveValues( summary = reactive({ req(forms_to_review_data) @@ -142,8 +145,8 @@ app_server <- function( "Edit date" = edit_date_time, status, reviewed) }), 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 +209,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"]) @@ -268,7 +263,8 @@ app_server <- function( id = "header_widgets_1", r = r, rev_data = rev_data, - navinfo = navinfo + navinfo = navinfo, + available_data = available_data ) @@ -298,7 +294,6 @@ 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({ @@ -309,15 +304,6 @@ app_server <- function( ) }) - 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 +315,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/fct_appdata_summary_tables.R b/R/fct_appdata_summary_tables.R index 0e30e6e0..6761bfb4 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,36 @@ 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 +96,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`, @@ -156,11 +178,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 +187,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 +240,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 +279,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_figures.R b/R/fct_figures.R index b51b3ba1..765e110c 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)) ) + diff --git a/R/mod_common_forms.R b/R/mod_common_forms.R index 04b76181..e9b9856d 100644 --- a/R/mod_common_forms.R +++ b/R/mod_common_forms.R @@ -74,9 +74,8 @@ 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()]. +#' @param timeline_data 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()], @@ -101,7 +100,7 @@ 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)) + stopifnot(is.data.frame(timeline_data)) names(form_items) <- names(form_items) %||% form_items moduleServer( id, function(input, output, session){ diff --git a/R/mod_header_widgets.R b/R/mod_header_widgets.R index bb813cf7..8ab23e1b 100644 --- a/R/mod_header_widgets.R +++ b/R/mod_header_widgets.R @@ -47,53 +47,32 @@ 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 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, + available_data + ){ stopifnot(is.reactivevalues(r)) stopifnot(is.reactivevalues(navinfo)) stopifnot(is.reactivevalues(rev_data)) + stopifnot(is.data.frame(available_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`) - }) - - 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" @@ -112,11 +91,10 @@ mod_header_widgets_server <- function(id, r, rev_data, navinfo){ ### 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,7 +102,9 @@ 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 ) 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_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_timeline.R b/R/mod_timeline.R index 2ac27952..c00ebfe5 100644 --- a/R/mod_timeline.R +++ b/R/mod_timeline.R @@ -31,7 +31,7 @@ mod_timeline_server <- function( ){ stopifnot( is.reactive(form_review_data), - is.reactive(timeline_data), + is.data.frame(timeline_data), is.reactive(active_subject) ) @@ -46,7 +46,7 @@ mod_timeline_server <- function( ) |> 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 +57,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/golem-config.yml b/inst/golem-config.yml index 11f27c38..19d1a69e 100644 --- a/inst/golem-config.yml +++ b/inst/golem-config.yml @@ -1,6 +1,6 @@ default: golem_name: clinsight - golem_version: 0.3.0.9006 + golem_version: 0.3.0.9007 app_prod: no user_identification: test_user study_data: !expr clinsight::clinsightful_data 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/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_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..3051aa24 100644 --- a/man/mod_common_forms_server.Rd +++ b/man/mod_common_forms_server.Rd @@ -47,9 +47,8 @@ that can uniquely identify one item/row.} 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()}}.} +\item{timeline_data}{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. diff --git a/man/mod_header_widgets_server.Rd b/man/mod_header_widgets_server.Rd index d3f05b9c..97828137 100644 --- a/man/mod_header_widgets_server.Rd +++ b/man/mod_header_widgets_server.Rd @@ -4,7 +4,7 @@ \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, available_data) } \arguments{ \item{id}{Character string, used to connect the module UI with the module @@ -17,6 +17,9 @@ 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{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_timeline_server.Rd b/man/mod_timeline_server.Rd index 8a8738b6..f1e29bab 100644 --- a/man/mod_timeline_server.Rd +++ b/man/mod_timeline_server.Rd @@ -13,9 +13,8 @@ Server.} \item{form_review_data}{A reactive value containing the review data of the respective form.} -\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{timeline_data}{A data frame containing the timeline data. Used to +create the timeline figure. Created with \code{\link[=get_timeline_data]{get_timeline_data()}}.} \item{active_subject}{A reactive value containing the active subject ID.} } diff --git a/tests/testthat/_snaps/get_available_data.md b/tests/testthat/_snaps/get_available_data.md index 06389ad9..88e7f0ea 100644 --- a/tests/testthat/_snaps/get_available_data.md +++ b/tests/testthat/_snaps/get_available_data.md @@ -1,20 +1,20 @@ # get_available_data() creates a data frame with all available data per individual. It summarizes the available data points for each individual for each time point. For forms with a 'Name' column (mostly common_forms but can also be study data forms) the Name column of the pivot table data will be used (for example, the specific adverse event or concomitant medication). For all other forms, the data points will be taken from event_name.: Creates the expected data frame with given random appdata input Code - get_available_data(data = appdata, tables = apptables, all_forms = all_forms) + dplyr::as_tibble(get_available_data(data = appdata)) Output - # A tibble: 1,968 x 6 - subject_id item_name form_repeat item_group event_name event_label - - 1 BEL_04_772 Hypotension 1 Adverse e~ Any visit Any visit - 2 BEL_04_772 Atrial Fibrillation~ 2 Adverse e~ Any visit Any visit - 3 BEL_04_772 Tachycardia 3 Adverse e~ Any visit Any visit - 4 BEL_04_772 Urinary Tract Infec~ 4 Adverse e~ Any visit Any visit - 5 BEL_04_772 Atrial Fibrillation~ 5 Adverse e~ Any visit Any visit - 6 BEL_07_193 Atelectasis 1 Adverse e~ Any visit Any visit - 7 BEL_08_736 Hypotension 1 Adverse e~ Any visit Any visit - 8 BEL_08_885 Seizure (N: 1) 1 Adverse e~ Any visit Any visit - 9 BEL_08_885 Seizure (N: 3) 3 Adverse e~ Any visit Any visit - 10 BEL_08_885 Urinary Incontinence 2 Adverse e~ Any visit Any visit - # i 1,958 more rows + # A tibble: 2,235 x 7 + subject_id item_name form_repeat item_group event_name event_label event_date + + 1 BEL_04_772 Hypotens~ 1 Adverse e~ Any visit 2023-08-31 + 2 BEL_04_772 Atrial F~ 2 Adverse e~ Any visit 2023-08-31 + 3 BEL_04_772 Tachycar~ 3 Adverse e~ Any visit 2023-08-31 + 4 BEL_04_772 Urinary ~ 4 Adverse e~ Any visit 2023-08-31 + 5 BEL_04_772 Atrial F~ 5 Adverse e~ Any visit 2023-08-31 + 6 BEL_07_193 Atelecta~ 1 Adverse e~ Any visit 2023-09-14 + 7 BEL_08_736 Hypotens~ 1 Adverse e~ Any visit 2023-09-13 + 8 BEL_08_885 Seizure ~ 1 Adverse e~ Any visit 2023-08-15 + 9 BEL_08_885 Urinary ~ 2 Adverse e~ Any visit 2023-09-06 + 10 BEL_08_885 Seizure ~ 3 Adverse e~ Any visit 2023-09-06 + # i 2,225 more rows diff --git a/tests/testthat/_snaps/get_static_overview_data.md b/tests/testthat/_snaps/get_static_overview_data.md index 0cd3f368..d0ed3c12 100644 --- a/tests/testthat/_snaps/get_static_overview_data.md +++ b/tests/testthat/_snaps/get_static_overview_data.md @@ -1,21 +1,27 @@ # get_static_overview_data() works. : creates the expected output Code - get_static_overview_data(data = appdata, expected_general_columns = metadata$ - general$item_name) + get_static_overview_data(data = appdata, available_data, + expected_general_columns = metadata$general$item_name) Output - # A tibble: 25 x 6 - subject_id subject_status WHO.classification Age Sex event_name - - 1 BEL_04_133 Enrolled Syndrome K 88 Male Screening, ~ - 2 BEL_04_772 Enrolled Syndrome O 78 Male Screening, ~ - 3 BEL_07_193 Enrolled Syndrome D 26 Female Screening - 4 BEL_07_431 Unknown 42 Male Screening - 5 BEL_07_497 Withdrawal by subject 50 Female Screening - 6 BEL_07_645 Enrolled Syndrome J 46 Male Screening, ~ - 7 BEL_08_45 Death Syndrome V 64 Male Screening - 8 BEL_08_736 Enrolled Syndrome A 45 Female Screening, ~ - 9 BEL_08_885 Enrolled Syndrome S 82 Male Screening, ~ - 10 BEL_09_361 Enrolled Syndrome G 38 Male Screening, ~ + # A tibble: 25 x 24 + subject_id Age Sex ECOG Eligible Eligible_Date WHO.classification + + 1 BEL_04_133 88 Male 1 Yes 2023-07-06 Syndrome K + 2 BEL_04_772 78 Male 0 Yes 2023-08-17 Syndrome O + 3 BEL_07_193 26 Female 1 Yes 2023-08-23 Syndrome D + 4 BEL_07_431 42 Male 1 + 5 BEL_07_497 50 Female Yes + 6 BEL_07_645 46 Male 1 Yes 2023-06-07 Syndrome J + 7 BEL_08_45 64 Male 2 Yes Syndrome V + 8 BEL_08_736 45 Female 0 Yes 2023-08-17 Syndrome A + 9 BEL_08_885 82 Male 1 Yes 2023-07-05 Syndrome S + 10 BEL_09_361 38 Male 0 Yes 2023-07-05 Syndrome G # i 15 more rows + # i 17 more variables: WHO.subclassification , Race , + # ChildbearingPotential , MenopauseReason , + # DiscontinuationDate , DiscontinuationReason , + # DisconDeathDate , DrugAdminDate , DrugAdminDose , + # DoseModificationDate , DoseModificationReason , + # DoseModificationNewDose , DrugDiscontDate , ... diff --git a/tests/testthat/test-fct_appdata_summary_tables.R b/tests/testthat/test-fct_appdata_summary_tables.R index b545a371..fafa6887 100644 --- a/tests/testthat/test-fct_appdata_summary_tables.R +++ b/tests/testthat/test-fct_appdata_summary_tables.R @@ -7,10 +7,8 @@ describe("get_timeline_data works", { ) |> get_appdata() appvars <- get_meta_vars(appdata) - apptables <- lapply(setNames(names(appdata), names(appdata)), \(x){ - create_table(appdata[[x]], expected_columns = names(appvars$items[[x]])) - }) - output <- get_timeline_data(appdata, apptables) + available_data <- get_available_data(appdata) + output <- get_timeline_data(appdata, available_data) expect_true(is.data.frame(output)) expect_equal( names(output), @@ -26,32 +24,49 @@ describe("get_timeline_data works", { ) |> get_appdata() appvars <- get_meta_vars(appdata) - apptables <- lapply(setNames(names(appdata), names(appdata)), \(x){ - create_table(appdata[[x]], expected_columns = names(appvars$items[[x]])) - }) + available_data <- get_available_data(appdata) expected_columns <- c("subject_id", "content", "form_repeat", "item_group", "start", "group", "end", "title", "className", "id", "order") + output <- get_timeline_data(appdata["Adverse events"], available_data) + expect_true(is.data.frame(output)) + expect_equal(names(output), expected_columns) - output <- get_timeline_data(appdata["Adverse events"], apptables["Adverse events"]) + output <- get_timeline_data(appdata["Vital signs"], available_data) expect_true(is.data.frame(output)) expect_equal(names(output), expected_columns) - output <- get_timeline_data(appdata["Vital signs"], apptables["Vital signs"]) + output <- get_timeline_data(appdata["General"], available_data) expect_true(is.data.frame(output)) expect_equal(names(output), expected_columns) - output <- get_timeline_data(appdata["General"], apptables["General"]) + expect_warning( + output <- get_timeline_data(appdata["Gener"], available_data), + "No data found" + ) expect_true(is.data.frame(output)) expect_equal(names(output), expected_columns) expect_warning( - get_timeline_data(appdata["Gener"], apptables["Gener"]), + output <- get_timeline_data(appdata["Gener"]), "No data found" ) - output <- get_timeline_data(appdata["Gener"], apptables["Gener"]) |> - suppressWarnings() expect_true(is.data.frame(output)) expect_equal(names(output), expected_columns) + + }) + it("gathers visit data from data frame if data frame available_data is not provided", { + appdata <- clinsightful_data |> + dplyr::filter( + subject_id %in% c("BEL_08_885"), + item_group %in% c("Adverse events", "Vital signs", "General") + ) |> + get_appdata() + expected_columns <- c("subject_id", "content", "form_repeat", "item_group", + "start", "group", "end", "title", "className", "id", "order") + output <- get_timeline_data(appdata["Vital signs"]) + expect_true(is.data.frame(output)) + expect_equal(names(output), expected_columns) + expect_equal(output$content, c("Screening", "Visit 1")) }) }) diff --git a/tests/testthat/test-get_available_data.R b/tests/testthat/test-get_available_data.R index 5ceec292..2c4fa278 100644 --- a/tests/testthat/test-get_available_data.R +++ b/tests/testthat/test-get_available_data.R @@ -7,37 +7,34 @@ describe( "concomitant medication). For all other forms, the data points ", "will be taken from event_name."), { - appdata <- get_appdata(clinsightful_data) - vars <- get_meta_vars(appdata) - all_forms <- data.frame( - main_tab = c(rep("Common events", times = 4), rep("Study data", times = 5)), - form = c("Adverse events", "Conc. Procedures", "Medical History", "Medication", - "CBC regular", "Electrolytes", "Liver function", - "Renal function", "Vital signs") - ) - apptables <- lapply( - setNames(names(appdata), names(appdata)), \(x){ - create_table(appdata[[x]], expected_columns = names(vars$items[[x]])) - }) + appdata <- get_appdata(clinsightful_data, metadata) it("Creates a data frame with the correct columns per individual. ", { - testdata <- get_available_data(data = appdata, tables = apptables, - all_forms = all_forms) + testdata <- get_available_data(data = appdata) expect_true(is.data.frame(testdata)) - expect_equal(names(testdata), c("subject_id", "item_name", "form_repeat", - "item_group", "event_name", "event_label")) + expect_equal(names(testdata), c("subject_id", "item_name", "form_repeat", + "item_group", "event_name", "event_label", + "event_date")) }) - it("Creates the expected data frame with given random appdata input", { - expect_snapshot( - get_available_data(data = appdata, tables = apptables, all_forms = all_forms) + it("summarizes study_fom data correctly", { + testdata <- get_available_data(data = appdata['Electrolytes']) + expect_equal( + unique(testdata$item_name), + levels(appdata$Electrolytes$item_name) + ) + expect_equal( + unique(testdata$subject_id), + unique(appdata$Electrolytes$subject_id) ) + expect_equal(names(testdata), c("subject_id", "item_name", "form_repeat", + "item_group", "event_name", "event_label", + "event_date")) + }) + it("Creates the expected data frame with given random appdata input", { + expect_snapshot(dplyr::as_tibble(get_available_data(data = appdata))) }) it("Adds a form_repeat number to item_name if duplicates occur within an individual, to ensure item names can be uniquely identified", { - df <- get_available_data( - data = list(), - tables = apptables["Adverse events"], - all_forms = all_forms - ) + df <- get_available_data(data = appdata['Adverse events']) # ID BEL_08_885 has two adverse events named 'Seizure'; these should show # up with the correct form_repeat number in the item_name expect_equal( @@ -48,9 +45,7 @@ describe( it("can change the name of the form_repeat number that is written to the item_name if duplicates occur", { df <- get_available_data( - data = list(), - tables = apptables["Adverse events"], - all_forms = all_forms, + data = appdata['Adverse events'], form_repeat_name = "custom_name" ) expect_equal( @@ -62,36 +57,32 @@ describe( independent of the form being in common forms or not.", { common_form_outcome <- get_available_data( - data = appdata['Adverse events'], - tables = apptables["Adverse events"], - all_forms = all_forms + data = appdata['Adverse events'] ) move_form <- data.frame("main_tab" = "Study data", "form" = "Adverse events") study_form_outcome <- get_available_data( - data = appdata['Adverse events'], - tables = apptables["Adverse events"], - all_forms = move_form + data = appdata['Adverse events'] ) expect_equal(common_form_outcome, study_form_outcome) } ) it("creates a event-based output if a 'Name' column does not exist in the data, even if the data is in the common_forms tab", { - study_form_outcome <- get_available_data( - data = appdata['Electrolytes'], - tables = apptables["Electrolytes"], - all_forms = all_forms - ) + study_form_outcome <- get_available_data(appdata['Electrolytes']) move_form <- data.frame("main_tab" = "Common forms", "form" = "Electrolytes") - common_form_outcome <- get_available_data( - data = appdata['Electrolytes'], - tables = apptables["Electrolytes"], - all_forms = move_form - ) + common_form_outcome <- get_available_data(appdata['Electrolytes']) expect_equal(common_form_outcome, study_form_outcome) }) + it("does not error if required columns are missing", { + appdata[['test-data']] <- data.frame() + expect_no_error( + outcome_1 <- get_available_data(appdata[c('test-data', 'Electrolytes')]) + ) + outcome_2 <- get_available_data(appdata[c('Electrolytes')]) + expect_equal(outcome_1, outcome_2) + }) it("Scenario 3 - Given ... and some forms defined in the metadata but completely missing in the data or tables, I expect that I still get a table with available data", { diff --git a/tests/testthat/test-get_static_overview_data.R b/tests/testthat/test-get_static_overview_data.R index d595c1b6..b8d6ee22 100644 --- a/tests/testthat/test-get_static_overview_data.R +++ b/tests/testthat/test-get_static_overview_data.R @@ -2,6 +2,7 @@ describe( "get_static_overview_data() works. ", { appdata <- get_appdata(clinsightful_data) + available_data <- get_available_data(appdata) vars <- get_meta_vars(appdata) all_forms <- data.frame( main_tab = c(rep("Common events", times = 4), rep("Study data", times = 5)), @@ -9,21 +10,18 @@ describe( "CBC regular", "Electrolytes", "Liver function", "Renal function", "Vital signs") ) - apptables <- lapply( - setNames(names(appdata), names(appdata)), \(x){ - create_table(appdata[[x]], expected_columns = names(vars$items[[x]])) - }) it("creates the a data frame with the expected column names", { test_results <- get_static_overview_data( data = appdata, + available_data = available_data, expected_general_columns = metadata$general$item_name ) expect_true(is.data.frame(test_results)) expect_equal( names(test_results), - c("subject_id", "subject_status", "WHO.classification", - "Age", "Sex", "event_name") + c("subject_id", metadata$general$item_name, + "subject_status", "status_label", "event_name") ) }) @@ -31,6 +29,7 @@ describe( expect_snapshot( get_static_overview_data( data = appdata, + available_data, expected_general_columns = metadata$general$item_name ) ) diff --git a/tests/testthat/test-mod_common_forms.R b/tests/testthat/test-mod_common_forms.R index e06ea7bb..b8a95a6a 100644 --- a/tests/testthat/test-mod_common_forms.R +++ b/tests/testthat/test-mod_common_forms.R @@ -8,7 +8,7 @@ describe( form_items = "", active_subject = reactiveVal("DEU_02_482"), table_names = NULL, - timeline_data = reactiveVal() + timeline_data = data.frame() ) it("Can load the module UI, with functioning internal parameters.", { @@ -46,9 +46,6 @@ describe( ) |> get_appdata() appvars <- get_meta_vars(appdata) - apptables <- lapply(setNames(names(appdata), names(appdata)), \(x){ - create_table(appdata[[x]], expected_columns = names(appvars$items[[x]])) - }) rev_data <- get_review_data(appdata[["Adverse events"]]) |> dplyr::mutate( id = dplyr::row_number(), @@ -56,7 +53,7 @@ describe( status = sample(c("new", "old", "updated"), dplyr::n(), replace = TRUE) ) form_items <- appvars$items[["Adverse events"]] - timeline_data <- get_timeline_data(appdata, apptables) + timeline_data <- get_timeline_data(appdata) testargs <- list( form = "Adverse events", form_data = reactiveVal(appdata[["Adverse events"]]), @@ -64,7 +61,7 @@ describe( form_items = form_items, active_subject = reactiveVal("DEU_02_482"), table_names = NULL, - timeline_data = reactiveVal(timeline_data) + timeline_data = timeline_data ) it( "Scenario 1 - View Adverse events and SAE tables. Given the form [Adverse events], @@ -118,7 +115,7 @@ describe( form_items = form_items, active_subject = reactiveVal("DEU_02_482"), table_names = NULL, - timeline_data = reactiveVal(timeline_data) + timeline_data = timeline_data ) testServer(mod_common_forms_server, args = testargs, { diff --git a/tests/testthat/test-mod_header_widgets.R b/tests/testthat/test-mod_header_widgets.R index 27971f63..1eadd0e7 100644 --- a/tests/testthat/test-mod_header_widgets.R +++ b/tests/testthat/test-mod_header_widgets.R @@ -23,7 +23,8 @@ describe( ) ), rev_data = reactiveValues(), - navinfo = reactiveValues() + navinfo = reactiveValues(), + available_data = data.frame() ) testServer(mod_header_widgets_server, args = testargs, { ns <- session$ns @@ -59,23 +60,26 @@ describe( and the output [ae_box] to contain a html element, and the ouput [visit_figure] to contain a plot object.", { - AE_table <- data.frame( - "subject_id" = "Subj01", - "form_repeat" = 1:3, - `Serious Adverse Event` = c("No", "Yes", "No"), - check.names = FALSE - ) AE_figure_data <- data.frame( "subject_id" = "Subj01", "event_name" = "Screening", - "event_label" = factor("V0"), - "item_name" = "Other" + "event_label" = "SCR", + "item_group" = "Adverse events", + "form_repeat" = 1:3, + "item_name" = "Serious Adverse Event", + "item_value" = c("Yes", "No", "No") + ) + available_data <- data.frame( + subject_id = "Subj01", + item_name = "Serious Adverse Event", + form_repeat = 1:3, + item_group = "SAEs", + event_name = "", + event_label = factor("SCR") ) - testargs <- list( r = reactiveValues( - filtered_data = list("Adverse events" = AE_figure_data), - filtered_tables = list("Adverse events" = AE_table) + filtered_data = list("Adverse events" = AE_figure_data) ), rev_data = reactiveValues( summary = reactive({ @@ -86,16 +90,18 @@ describe( ) }) ), - navinfo = reactiveValues() + navinfo = reactiveValues(), + available_data = available_data ) testServer(mod_header_widgets_server, args = testargs, { ns <- session$ns r$subject_id = "Subj01" session$flushReact() - expect_equal(AEvals_active(), AE_table) - expect_equal(SAEvalue.individual(), 1) - expect_equal(AEvalue.individual(), 2) + expect_equal( + all_aes(), + data.frame("subject_id" = "Subj01", AEs = 2, SAEs = 1) + ) expect_false(all_AEs_reviewed()) expect_true(inherits(output$ae_box$html, "html")) expect_equal(output[["visit_figure"]]$alt, "Plot object") @@ -109,9 +115,7 @@ describe( and the active subject ID [r$subject_id] set to ['Subj02'], and the active subject having no adverse event data available, and the data frame [rev_data$summary()] containing no data of ['Subj02'], - I expect SAEvalue.individual() to be zero, - and AEvalue.individual() to be zero, - and the AEvals_active() table to be a data frame with zero rows, + I expect that zero AEs and zero SAEs are found for Subj02 in [all_aes()], and all_AEs_reviewed() to being set to 'TRUE', and output$ae_box to contain a html element, and ouput$visit_figure to contain a plot object.", @@ -122,16 +126,28 @@ describe( "Serious Adverse Event" = "No", check.names = FALSE ) + AE_figure_data <- data.frame( "subject_id" = "Subj01", "event_name" = "Screening", - "event_label" = factor("V0"), - "item_name" = "Other" + "event_label" = "SCR", + "item_group" = "Adverse events", + "form_repeat" = 1:3, + "item_name" = "Serious Adverse Event", + "item_value" = c("Yes", "No", "No") + ) + + available_data <- data.frame( + subject_id = c("Subj01", "Subj02"), + item_name = c("Serious Adverse Event", "other_event"), + form_repeat = 1, + item_group = c("Adverse events", "vital_signs"), + event_name = "", + event_label = factor("V0") ) testargs <- list( r = reactiveValues( - filtered_data = list("Adverse events" = AE_figure_data), - filtered_tables = list("Adverse events" = AE_table) + filtered_data = list("Adverse events" = AE_figure_data) ), rev_data = reactiveValues( summary = reactive({ @@ -142,16 +158,18 @@ describe( ) }) ), - navinfo = reactiveValues() + navinfo = reactiveValues(), + available_data = available_data ) testServer(mod_header_widgets_server, args = testargs, { ns <- session$ns r$subject_id = "Subj02" session$flushReact() - expect_equal(AEvals_active(), AE_table[0,]) - expect_equal(SAEvalue.individual(), 0) - expect_equal(AEvalue.individual(), 0) + expect_equal( + dplyr::filter(all_aes(), subject_id == "Subj02"), + data.frame("subject_id" = "Subj02", AEs = 0, SAEs = 0) + ) expect_true(all_AEs_reviewed()) expect_true(inherits(output$ae_box$html, "html")) expect_equal(output[["visit_figure"]]$alt, "Plot object") diff --git a/tests/testthat/test-mod_header_widgets_fct_helpers.R b/tests/testthat/test-mod_header_widgets_fct_helpers.R new file mode 100644 index 00000000..e3e99d99 --- /dev/null +++ b/tests/testthat/test-mod_header_widgets_fct_helpers.R @@ -0,0 +1,85 @@ +describe("count_adverse_events works", { + AE_data <- data.frame( + "subject_id" = "Subj01", + "event_name" = "Screening", + "item_group" = "Adverse events", + "form_repeat" = 1, + "item_name" = "Serious Adverse Event", + "item_value" = "No" + ) + it("Gives the expected output", { + expect_equal( + count_adverse_events(AE_data), + data.frame("subject_id" = "Subj01", AEs = 1, SAEs = 0) + ) + }) + it("expands the table with expected ids if they do not occur in the AE table", { + expected_outcome <- data.frame( + "subject_id" = c("Subj01", "Subj02"), + AEs = c(1, 0), + SAEs = c(0,0) + ) + expect_equal( + count_adverse_events(AE_data, all_ids = c("Subj01", "Subj02")), + expected_outcome + ) + }) + it("Warns if item 'Serious Adverse Event' was not found and returns a data + frame with question marks as AEs and SAEs", + { + AE_data <- data.frame( + "subject_id" = "Subj01", + "event_name" = "Screening", + "item_group" = "Adverse events", + "form_repeat" = 1, + "item_name" = "xxx", + "item_value" = "No" + ) + expect_warning( + df <- count_adverse_events(AE_data), + "item 'Serious Adverse Event' not found" + ) + expect_equal(df, data.frame(subject_id = "Subj01", AEs = "?", "SAEs" = "?")) + } + ) + it("provides an empty data frame if data contains zero rows", { + expect_equal( + count_adverse_events(data.frame()), + data.frame(subject = character(), AEs = numeric(), SAEs = numeric()) + ) + }) + it("errors if any of the key_columns or the item_value column are missing", { + AE_data <- data.frame( + "subject_id" = "Subj01", + "event_name" = "Screening", + "item_group" = "Adverse events", + "form_repeat" = 1, + "item_name" = "xxx", + "item_value" = "No" + ) + expect_error( + count_adverse_events(dplyr::select(AE_data, -subject_id)), + "One or more required columns are missing" + ) + expect_error( + count_adverse_events(dplyr::select(AE_data, -event_name)), + "One or more required columns are missing" + ) + expect_error( + count_adverse_events(dplyr::select(AE_data, -item_group)), + "One or more required columns are missing" + ) + expect_error( + count_adverse_events(dplyr::select(AE_data, -form_repeat)), + "One or more required columns are missing" + ) + expect_error( + count_adverse_events(dplyr::select(AE_data, -item_name)), + "One or more required columns are missing" + ) + expect_error( + count_adverse_events(dplyr::select(AE_data, -item_value)), + "One or more required columns are missing" + ) + }) +}) diff --git a/tests/testthat/test-mod_main_sidebar.R b/tests/testthat/test-mod_main_sidebar.R index c66e1ddb..f375871a 100644 --- a/tests/testthat/test-mod_main_sidebar.R +++ b/tests/testthat/test-mod_main_sidebar.R @@ -5,7 +5,7 @@ describe("mod_main_sidebar. Feature 1 | Load application module in isolation.", r = reactiveValues(create_query = 0, review_data = reactiveValues()), navinfo = reactiveValues(), app_data = list("Form1" = data.frame("site_code" = "", "edit_date_time" = "2023-01-01")), # used by mod_review_config() - app_tables = list(), + #app_tables = list(), app_vars = list( all_forms = data.frame(), Sites = data.frame(), @@ -60,15 +60,12 @@ describe( ) |> {\(x) split(x, x$item_group)}() vars <- get_meta_vars(appdata, metadata) - apptables <- lapply( - setNames(names(appdata), names(appdata)), \(x){ - create_table(appdata[[x]], expected_columns = names(vars$items[[x]])) - }) + all_forms <- data.frame( main_tab = c("Common events", "Study data"), form = c("Adverse events", "Vital signs") ) - available_data <- get_available_data(appdata, apptables, all_forms = all_forms) + available_data <- get_available_data(appdata) test_ui <- function(request){ bslib::page_navbar(sidebar = mod_main_sidebar_ui("test")) @@ -87,7 +84,6 @@ describe( ), navinfo = reactiveValues(active_form = "Adverse events", active_tab = "Common events"), app_data = list("Form1" = data.frame("site_code" = "")), # used by mod_review_config() - app_tables = list(), app_vars = list( all_forms = data.frame(), Sites = data.frame(), @@ -147,7 +143,6 @@ describe( ), navinfo = reactiveValues(active_form = "Adverse events", active_tab = "Start"), app_data = list("Form1" = data.frame("site_code" = "")), # used by mod_review_config() - app_tables = list(), app_vars = list( all_forms = data.frame(), Sites = data.frame(), @@ -188,7 +183,6 @@ describe( r = reactiveValues(create_query = 0, review_data = reactiveValues()), navinfo = reactiveValues(), app_data = list("Form1" = data.frame("site_code" = "", "edit_date_time" = "2023-01-01")), # used by mod_review_config() - app_tables = list(), app_vars = list( all_forms = data.frame(), Sites = data.frame(), @@ -223,7 +217,6 @@ describe( r = reactiveValues(create_query = 0, review_data = reactiveValues()), navinfo = reactiveValues(), app_data = list("Form1" = data.frame("site_code" = "", "edit_date_time" = "2023-01-01")), # used by mod_review_config() - app_tables = list(), app_vars = list( all_forms = data.frame(), Sites = data.frame(), diff --git a/tests/testthat/test-mod_navigate_participants.R b/tests/testthat/test-mod_navigate_participants.R index 8e738a33..d782be2f 100644 --- a/tests/testthat/test-mod_navigate_participants.R +++ b/tests/testthat/test-mod_navigate_participants.R @@ -1,16 +1,10 @@ describe("mod_navigate_participants. Feature 1 | Load application module in isolation.", { testargs <- list( r = reactiveValues( - filtered_tables = list( - General = data.frame( - subject_id = c("Subj1", "Subj2", "Subj3"), - subject_status = "", - status_label = c("lab1", "lab2", "lab3") - ) - ), subject_id = "", filtered_subjects = c("Subj1", "Subj2", "Subj3") - ) + ), + static_overview_data = data.frame() ) it("Can load the module UI, with functioning internal parameters.", { ui <- mod_navigate_participants_ui(id = "test") @@ -40,18 +34,17 @@ describe( selected patient. After pressing save, the patient should be selected as active patient in the app.", { + static_overview_data <- data.frame( + subject_id = c("Subj1", "Subj2", "Subj3"), + subject_status = "", + status_label = c("lab1", "lab2", "lab3") + ) testargs <- list( r = reactiveValues( - filtered_tables = list( - General = data.frame( - subject_id = c("Subj1", "Subj2", "Subj3"), - subject_status = "", - status_label = c("lab1", "lab2", "lab3") - ) - ), subject_id = "", filtered_subjects = c("Subj1", "Subj2", "Subj3") - ) + ), + static_overview_data = static_overview_data ) it( "Scenario 1 - Given a table with general information in reactiveValues [r], @@ -157,17 +150,15 @@ describe( mod_navigate_participants_server( id = "test", r = reactiveValues( - filtered_tables = list( - General = data.frame( - subject_id = c("Subj1", "Subj2", "Subj3"), - subject_status = "", - status_label = c("lab1", "lab2", "lab3"), - Sex = c("Male", "Female", "Female"), - Age = c(70, 16, 29) - ) - ), subject_id = "Subj1", filtered_subjects = c("Subj1", "Subj2", "Subj3") + ), + static_overview_data = data.frame( + subject_id = c("Subj1", "Subj2", "Subj3"), + subject_status = "", + status_label = c("lab1", "lab2", "lab3"), + Sex = c("Male", "Female", "Female"), + Age = c(70, 16, 29) ) ) } @@ -179,7 +170,6 @@ describe( height = 670 ) withr::defer(app$stop()) - app$expect_values() app$wait_for_js("$('#test-subject_info').click()") diff --git a/tests/testthat/test-mod_review_config.R b/tests/testthat/test-mod_review_config.R index fb07b66a..2e67b686 100644 --- a/tests/testthat/test-mod_review_config.R +++ b/tests/testthat/test-mod_review_config.R @@ -10,7 +10,6 @@ describe( user_role = "Medical Monitor" ), app_data = appdata, - app_tables = list("tab1" = data.frame(subject_id = vars$subject_id)), sites = vars$Sites, subject_ids = "DEU_02_866" ) @@ -45,7 +44,6 @@ describe( { appdata <- get_appdata(clinsightful_data) vars <- get_meta_vars(appdata, metadata) - apptables <- list("tab1" = data.frame(subject_id = vars$subject_id)) testargs <- list( r = reactiveValues(subject_id = "DEU_02_866", @@ -53,10 +51,8 @@ describe( user_roles = "Medical Monitor", user_role = "Medical Monitor", filtered_data = appdata, - filtered_tables = apptables, filtered_subjects = vars$subject_id), app_data = appdata, - app_tables = apptables, sites = vars$Sites, subject_ids = vars$subject_id ) @@ -163,13 +159,12 @@ describe( user_roles = "Medical Monitor", user_role = "Medical Monitor", filtered_data = appdata, - filtered_tables = apptables, filtered_subjects = vars$subject_id ) mod_review_config_server( "test", r, app_data = appdata, - app_tables = apptables, sites = vars$Sites, subject_ids = vars$subject_id + sites = vars$Sites, subject_ids = vars$subject_id ) exportTestValues(filtered_data = r$filtered_data) } @@ -234,7 +229,6 @@ describe( I expect that the user role is changed to 'Medical Monitor'.", { appdata <- get_appdata(clinsightful_data) vars <- get_meta_vars(appdata, metadata) - apptables <- list("tab1" = data.frame(subject_id = vars$subject_id)) testargs <- list( r = reactiveValues(subject_id = "DEU_02_866", @@ -243,10 +237,8 @@ describe( "Medical Monitor"), user_role = "Administrator", filtered_data = appdata, - filtered_tables = apptables, filtered_subjects = vars$subject_id), app_data = appdata, - app_tables = apptables, sites = vars$Sites, subject_ids = vars$subject_id ) diff --git a/tests/testthat/test-mod_review_config_fct_helpers.R b/tests/testthat/test-mod_review_config_fct_helpers.R index 1c0932ef..ee40a1fc 100644 --- a/tests/testthat/test-mod_review_config_fct_helpers.R +++ b/tests/testthat/test-mod_review_config_fct_helpers.R @@ -11,16 +11,6 @@ describe( site_code = c("Sitex") ) ) - app_tables <- list( - "ECG" = data.frame( - subject_id = c("Subj01", "Subj02", "Subj03"), - site_code = c("NL01", "DE03", "AU01") - ), - "not_included" = data.frame( - subject_id = c("Subjx"), - site_code = c("Sitex") - ) - ) it("Filters lists of appdata and apptables with the required sites, and returns the data in a reactiveValues object.", { @@ -30,15 +20,14 @@ describe( rvals, sites = c("NL01", "DE03"), subject_ids = c("Subj01", "Subj02", "Subj03"), - appdata = app_data, - apptables = app_tables + appdata = app_data ) }) expect_true(is.reactive(outcome)) outcome.list <- isolate(reactiveValuesToList(outcome())) expect_equal( names(outcome.list), - c("filtered_data", "filtered_subjects", "filtered_tables", "subject_id") + c("filtered_data", "filtered_subjects", "subject_id") ) expect_equal( outcome.list$filtered_subjects, @@ -49,8 +38,8 @@ describe( c("NL01", "DE03") ) expect_equal( - outcome.list$filtered_data, - outcome.list$filtered_tables + outcome.list$subject_id, + "Subj01" ) }) diff --git a/tests/testthat/test-mod_timeline.R b/tests/testthat/test-mod_timeline.R index 7a6484c4..61135584 100644 --- a/tests/testthat/test-mod_timeline.R +++ b/tests/testthat/test-mod_timeline.R @@ -14,7 +14,7 @@ describe( it("Can load the module server, with functioning internal parameters.", { testargs <- list( form_review_data = reactiveVal(), - timeline_data = reactiveVal(), + timeline_data = data.frame(), active_subject = reactiveVal("BEL_04_133") ) testServer(mod_timeline_server, args = testargs , { @@ -41,14 +41,10 @@ describe( status = sample(c("new", "old", "updated"), dplyr::n(), replace = TRUE) ) appvars <- get_meta_vars(appdata) - apptables <- lapply(setNames(names(appdata), names(appdata)), \(x){ - create_table(appdata[[x]], expected_columns = names(appvars$items[[x]])) - }) - timeline_data <- get_timeline_data(appdata, apptables) - + timeline_data <- get_timeline_data(appdata) testargs <- list( form_review_data = reactiveVal(rev_data), - timeline_data = reactiveVal(timeline_data), + timeline_data = timeline_data, active_subject = reactiveVal("BEL_04_133") ) it("Scenario 1 - Given a Form 'Adverse events', I expect @@ -58,8 +54,8 @@ describe( ns <- session$ns expect_true(is.data.frame(timeline_data_active())) expect_equal(nrow(timeline_data_active()), 10) - expect_true(is.data.frame(timeline_data())) - expect_equal(nrow(timeline_data()), 203) + expect_true(is.data.frame(timeline_data)) + expect_equal(nrow(timeline_data), 203) expect_true(inherits(output$timeline, "json")) }) }) @@ -78,14 +74,11 @@ describe( status = sample(c("new", "old", "updated"), dplyr::n(), replace = TRUE) ) appvars <- get_meta_vars(appdata) - apptables <- lapply(setNames(names(appdata), names(appdata)), \(x){ - create_table(appdata[[x]], expected_columns = names(appvars$items[[x]])) - }) - timeline_data <- get_timeline_data(appdata, apptables) + timeline_data <- get_timeline_data(appdata) testargs <- list( form_review_data = reactiveVal(rev_data), - timeline_data = reactiveVal(timeline_data), + timeline_data = timeline_data, active_subject = reactiveVal("BEL_04_133") ) it("Scenario 1 - Standard label. Given a Form 'Adverse events', @@ -104,13 +97,12 @@ describe( { timeline_data <- get_timeline_data( appdata, - apptables, treatment_label = "custom_treatment_label" - ) - + ) + testargs <- list( form_review_data = reactiveVal(rev_data), - timeline_data = reactiveVal(timeline_data), + timeline_data = timeline_data, active_subject = reactiveVal("BEL_04_133") ) testServer(mod_timeline_server, args = testargs, {