From d930ae533c35da8884c661c0045b24bbb20624c0 Mon Sep 17 00:00:00 2001 From: LDSamson Date: Fri, 28 Nov 2025 11:01:33 +0100 Subject: [PATCH 01/37] simplify get_available data so that only main datset is needed to create the summary data frame --- R/fct_appdata_summary_tables.R | 31 +++++++++++++-------- tests/testthat/_snaps/get_available_data.md | 4 +-- tests/testthat/test-get_available_data.R | 4 +-- 3 files changed, 24 insertions(+), 15 deletions(-) diff --git a/R/fct_appdata_summary_tables.R b/R/fct_appdata_summary_tables.R index 0e30e6e0..46976aa9 100644 --- a/R/fct_appdata_summary_tables.R +++ b/R/fct_appdata_summary_tables.R @@ -179,19 +179,28 @@ get_available_data <- function( study_event_selectors <- lapply( all_forms$form, \(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(is.null(data[[x]])) return(NULL) + if( + !any(unique(data[[x]]$item_name) %in% name_vars) + ){ + df_x <- data[[x]][ + c("subject_id", "event_name", "event_label", "item_group", + "item_name", "form_repeat") + ] } 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 <- data[[x]][ + data[[x]]$item_name %in% name_vars, + c("subject_id", "item_value", "form_repeat"), + drop = FALSE + ] |> + dplyr::rename("item_name" = item_value) |> + dplyr::mutate( + item_group = x, + event_name = "Any visit", + event_label = "Any visit" + ) } df_x |> dplyr::distinct() |> diff --git a/tests/testthat/_snaps/get_available_data.md b/tests/testthat/_snaps/get_available_data.md index 06389ad9..9658e18a 100644 --- a/tests/testthat/_snaps/get_available_data.md +++ b/tests/testthat/_snaps/get_available_data.md @@ -14,7 +14,7 @@ 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 + 9 BEL_08_885 Urinary Incontinence 2 Adverse e~ Any visit Any visit + 10 BEL_08_885 Seizure (N: 3) 3 Adverse e~ Any visit Any visit # i 1,958 more rows diff --git a/tests/testthat/test-get_available_data.R b/tests/testthat/test-get_available_data.R index 5ceec292..64561c4d 100644 --- a/tests/testthat/test-get_available_data.R +++ b/tests/testthat/test-get_available_data.R @@ -34,8 +34,8 @@ describe( 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"], + data = appdata['Adverse events'], + tables = list(), all_forms = all_forms ) # ID BEL_08_885 has two adverse events named 'Seizure'; these should show From 7dfbfb35c4d39156ececec72ac11341a49e4b2c0 Mon Sep 17 00:00:00 2001 From: LDSamson Date: Fri, 28 Nov 2025 11:02:03 +0100 Subject: [PATCH 02/37] Simplify further --- R/fct_appdata_summary_tables.R | 39 +++++++++++----------------------- 1 file changed, 12 insertions(+), 27 deletions(-) diff --git a/R/fct_appdata_summary_tables.R b/R/fct_appdata_summary_tables.R index 46976aa9..88a572c9 100644 --- a/R/fct_appdata_summary_tables.R +++ b/R/fct_appdata_summary_tables.R @@ -156,11 +156,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,39 +165,29 @@ 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(is.list(data), 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") + if(length(data) == 0) { + warning("Empty list of data provided") + return(add_missing_columns(data.frame(), c(selector_cols, "n"))) + } study_event_selectors <- lapply( - all_forms$form, + data, \(x){ name_vars <- c("Name", "AE Name", "CP Name", "MH Name", "CM Name") - if(is.null(data[[x]])) return(NULL) - if( - !any(unique(data[[x]]$item_name) %in% name_vars) - ){ - df_x <- data[[x]][ - c("subject_id", "event_name", "event_label", "item_group", - "item_name", "form_repeat") - ] - } else { - if(is.null(tables[[x]])) return(NULL) - df_x <- data[[x]][ - data[[x]]$item_name %in% name_vars, - c("subject_id", "item_value", "form_repeat"), - drop = FALSE - ] |> - dplyr::rename("item_name" = item_value) |> + if ( any(unique(x$item_name) %in% name_vars)){ + x <- x[x$item_name %in% name_vars, ] |> dplyr::mutate( - item_group = x, + item_name = item_value, event_name = "Any visit", event_label = "Any visit" ) } - df_x |> + x[c(selector_cols)] |> dplyr::distinct() |> dplyr::arrange( subject_id, From 102680257d4f1c8ab3120258f6464616acaa97e8 Mon Sep 17 00:00:00 2001 From: LDSamson Date: Fri, 28 Nov 2025 11:06:58 +0100 Subject: [PATCH 03/37] Update docs and tests --- R/app_server.R | 2 - man/get_available_data.Rd | 9 +---- tests/testthat/test-get_available_data.R | 48 +++++------------------- 3 files changed, 10 insertions(+), 49 deletions(-) diff --git a/R/app_server.R b/R/app_server.R index 5ccd6406..5eba7094 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -45,8 +45,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"] 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/tests/testthat/test-get_available_data.R b/tests/testthat/test-get_available_data.R index 64561c4d..2119c7ff 100644 --- a/tests/testthat/test-get_available_data.R +++ b/tests/testthat/test-get_available_data.R @@ -7,37 +7,21 @@ 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")) }) it("Creates the expected data frame with given random appdata input", { expect_snapshot( - get_available_data(data = appdata, tables = apptables, all_forms = all_forms) + 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 = appdata['Adverse events'], - tables = list(), - 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 +32,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,34 +44,22 @@ 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("Scenario 3 - Given ... and some forms defined in the metadata but From 431eb062065f7f3be7d2ab2d7a0b2da8998f6ab6 Mon Sep 17 00:00:00 2001 From: LDSamson Date: Fri, 28 Nov 2025 11:13:23 +0100 Subject: [PATCH 04/37] Remove duplicate module server --- R/app_server.R | 9 --------- 1 file changed, 9 deletions(-) diff --git a/R/app_server.R b/R/app_server.R index 5eba7094..da768186 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -307,15 +307,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, From 60c3dd52c2812a017d07c73866856b3b9954ee30 Mon Sep 17 00:00:00 2001 From: LDSamson Date: Mon, 1 Dec 2025 18:08:43 +0100 Subject: [PATCH 05/37] rewrite get_static_overview_data so that it can be used in multiple places --- R/fct_appdata_summary_tables.R | 14 +++++--------- 1 file changed, 5 insertions(+), 9 deletions(-) diff --git a/R/fct_appdata_summary_tables.R b/R/fct_appdata_summary_tables.R index 88a572c9..178f4f63 100644 --- a/R/fct_appdata_summary_tables.R +++ b/R/fct_appdata_summary_tables.R @@ -230,19 +230,16 @@ get_available_data <- function( #' get_static_overview_data <- function( data, + available_data, expected_general_columns = NULL ){ stopifnot(is.list(data)) 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() @@ -251,6 +248,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") } From 70fc2b97785f7c064d33f44ce761638e0e9d570d Mon Sep 17 00:00:00 2001 From: LDSamson Date: Mon, 1 Dec 2025 18:12:34 +0100 Subject: [PATCH 06/37] Rewrite mod_header_widgets to remove dependency on filtered_tables --- R/mod_header_widgets.R | 58 +++++++++++++++--------------------------- 1 file changed, 20 insertions(+), 38 deletions(-) diff --git a/R/mod_header_widgets.R b/R/mod_header_widgets.R index bb813cf7..ff959431 100644 --- a/R/mod_header_widgets.R +++ b/R/mod_header_widgets.R @@ -49,10 +49,17 @@ mod_header_widgets_ui <- function(id){ #' on the adverse event box. #' #' @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 @@ -61,39 +68,13 @@ mod_header_widgets_server <- function(id, r, rev_data, navinfo){ 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 +93,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(), AEs[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 +104,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 ) From eb3c185c6291b771e1de49d863d5e1d531ecc48e Mon Sep 17 00:00:00 2001 From: LDSamson Date: Mon, 1 Dec 2025 18:13:31 +0100 Subject: [PATCH 07/37] Use static overview data in mod_navigate_participants instead of table data --- R/app_server.R | 6 +++++- R/mod_navigate_participants.R | 17 +++++++++-------- 2 files changed, 14 insertions(+), 9 deletions(-) diff --git a/R/app_server.R b/R/app_server.R index da768186..559c8d8e 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -318,7 +318,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/mod_navigate_participants.R b/R/mod_navigate_participants.R index 2d758e34..3733782f 100644 --- a/R/mod_navigate_participants.R +++ b/R/mod_navigate_participants.R @@ -29,7 +29,11 @@ mod_navigate_participants_ui <- function(id){ #' #' @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 +115,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 +128,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 +138,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."), From 4971534aa6f0a5a88e6c9bc6ad4b16b08acfad82 Mon Sep 17 00:00:00 2001 From: LDSamson Date: Mon, 1 Dec 2025 18:15:05 +0100 Subject: [PATCH 08/37] Rewrite get_timeline_data to only use AE table data --- R/app_server.R | 6 +++++- R/fct_appdata_summary_tables.R | 8 ++++---- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/R/app_server.R b/R/app_server.R index 559c8d8e..90bbb7ac 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -208,7 +208,11 @@ app_server <- function( timeline_data <- reactive({ get_timeline_data( r$filtered_data, - r$filtered_tables, + if (!is.null(r$filtered_data[["Adverse events"]])) { + create_table(r$filtered_data[["Adverse events"]]) + } else { + data.frame() + }, treatment_label = meta$settings$treatment_label %||% "\U1F48A T\U2093" ) }) diff --git a/R/fct_appdata_summary_tables.R b/R/fct_appdata_summary_tables.R index 178f4f63..b00e1c3b 100644 --- a/R/fct_appdata_summary_tables.R +++ b/R/fct_appdata_summary_tables.R @@ -21,7 +21,7 @@ get_timeline_data <- function( "start", "group", "end", "title", "className", "id", "order"), treatment_label = "\U1F48A T\U2093" ){ - stopifnot(is.list(data), is.list(table_data)) + stopifnot(is.list(data), is.data.frame(table_data)) stopifnot(is.character(timeline_cols), is.character(treatment_label)) if(all(unlist(lapply(data, is.null)))) return({ @@ -49,10 +49,10 @@ get_timeline_data <- function( ) } - if(is.null(table_data$`Adverse events`)){ + if(nrow(table_data) == 0){ AE_timedata <- SAE_data <- data.frame() } else{ - AE_timedata <- table_data$`Adverse events` |> + AE_timedata <- table_data |> dplyr::filter(!(`Serious Adverse Event` == "Yes" & .data[["start date"]] == .data[["SAE Start date"]])) |> dplyr::mutate( @@ -74,7 +74,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`, From 9d089335bd07ac3803be2170646ab1ba0bbe7960 Mon Sep 17 00:00:00 2001 From: LDSamson Date: Mon, 1 Dec 2025 18:29:13 +0100 Subject: [PATCH 09/37] Phase out filtered_tables --- R/app_server.R | 17 +++++++---------- R/fct_appdata_summary_tables.R | 6 +----- R/mod_main_sidebar.R | 4 ---- R/mod_review_config.R | 6 ++---- R/mod_review_config_fct_helpers.R | 8 +------- man/filter_data.Rd | 5 +---- man/get_static_overview_data.Rd | 2 +- man/mod_header_widgets_server.Rd | 2 +- man/mod_main_sidebar_server.Rd | 4 ---- man/mod_navigate_participants_server.Rd | 2 +- man/mod_review_config_server.Rd | 6 ++---- 11 files changed, 17 insertions(+), 45 deletions(-) diff --git a/R/app_server.R b/R/app_server.R index 90bbb7ac..49ac5c4d 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() @@ -55,6 +51,7 @@ 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"]) ) @@ -65,7 +62,6 @@ app_server <- function( 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] ) @@ -114,7 +110,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( @@ -123,6 +119,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) @@ -140,8 +137,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) ) |> @@ -270,7 +267,8 @@ app_server <- function( id = "header_widgets_1", r = r, rev_data = rev_data, - navinfo = navinfo + navinfo = navinfo, + available_data = available_data ) @@ -300,7 +298,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({ diff --git a/R/fct_appdata_summary_tables.R b/R/fct_appdata_summary_tables.R index b00e1c3b..a04df27e 100644 --- a/R/fct_appdata_summary_tables.R +++ b/R/fct_appdata_summary_tables.R @@ -181,11 +181,7 @@ get_available_data <- function( name_vars <- c("Name", "AE Name", "CP Name", "MH Name", "CM Name") if ( any(unique(x$item_name) %in% name_vars)){ x <- x[x$item_name %in% name_vars, ] |> - dplyr::mutate( - item_name = item_value, - event_name = "Any visit", - event_label = "Any visit" - ) + dplyr::mutate(item_name = item_value) } x[c(selector_cols)] |> dplyr::distinct() |> 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_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/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_static_overview_data.Rd b/man/get_static_overview_data.Rd index d985a2b9..c330480c 100644 --- a/man/get_static_overview_data.Rd +++ b/man/get_static_overview_data.Rd @@ -4,7 +4,7 @@ \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.} diff --git a/man/mod_header_widgets_server.Rd b/man/mod_header_widgets_server.Rd index d3f05b9c..9677beb8 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 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..894e1ed8 100644 --- a/man/mod_navigate_participants_server.Rd +++ b/man/mod_navigate_participants_server.Rd @@ -4,7 +4,7 @@ \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.} 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.} From 9e16fb740f2c32967e1f261e14d7b9eab5ee06b9 Mon Sep 17 00:00:00 2001 From: LDSamson Date: Tue, 2 Dec 2025 10:05:31 +0100 Subject: [PATCH 10/37] Fix some tests. Add tests for new helper function --- R/mod_header_widgets_fct_helpers.R | 53 ++++++++++++ man/count_adverse_events.Rd | 24 ++++++ .../test-fct_appdata_summary_tables.R | 27 +++--- tests/testthat/test-mod_header_widgets.R | 73 ++++++++++------ .../test-mod_header_widgets_fct_helpers.R | 85 +++++++++++++++++++ tests/testthat/test-mod_main_sidebar.R | 13 +-- 6 files changed, 226 insertions(+), 49 deletions(-) create mode 100644 R/mod_header_widgets_fct_helpers.R create mode 100644 man/count_adverse_events.Rd create mode 100644 tests/testthat/test-mod_header_widgets_fct_helpers.R diff --git a/R/mod_header_widgets_fct_helpers.R b/R/mod_header_widgets_fct_helpers.R new file mode 100644 index 00000000..757e8d66 --- /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))) + stopifnot(is.character(all_ids %||% "")) + all_ids <- c(all_ids, unique(data[["subject_id"]])) + 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 = unique(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/man/count_adverse_events.Rd b/man/count_adverse_events.Rd new file mode 100644 index 00000000..a2f188af --- /dev/null +++ b/man/count_adverse_events.Rd @@ -0,0 +1,24 @@ +% 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} +} +\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/tests/testthat/test-fct_appdata_summary_tables.R b/tests/testthat/test-fct_appdata_summary_tables.R index b545a371..f5d67948 100644 --- a/tests/testthat/test-fct_appdata_summary_tables.R +++ b/tests/testthat/test-fct_appdata_summary_tables.R @@ -7,10 +7,12 @@ 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) + + ae_tables <- create_table( + appdata[["Adverse events"]], + expected_columns = names(appvars$items[["Adverse events"]]) + ) + output <- get_timeline_data(appdata, ae_tables) expect_true(is.data.frame(output)) expect_equal( names(output), @@ -26,29 +28,30 @@ 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]])) - }) + ae_tables <- create_table( + appdata[["Adverse events"]], + expected_columns = names(appvars$items[["Adverse events"]]) + ) expected_columns <- c("subject_id", "content", "form_repeat", "item_group", "start", "group", "end", "title", "className", "id", "order") - output <- get_timeline_data(appdata["Adverse events"], apptables["Adverse events"]) + output <- get_timeline_data(appdata["Adverse events"], ae_tables) 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["Vital signs"], ae_tables) expect_true(is.data.frame(output)) expect_equal(names(output), expected_columns) - output <- get_timeline_data(appdata["General"], apptables["General"]) + output <- get_timeline_data(appdata["General"], ae_tables) expect_true(is.data.frame(output)) expect_equal(names(output), expected_columns) expect_warning( - get_timeline_data(appdata["Gener"], apptables["Gener"]), + get_timeline_data(appdata["Gener"], ae_tables), "No data found" ) - output <- get_timeline_data(appdata["Gener"], apptables["Gener"]) |> + output <- get_timeline_data(appdata["Gener"], ae_tables) |> suppressWarnings() expect_true(is.data.frame(output)) expect_equal(names(output), expected_columns) diff --git a/tests/testthat/test-mod_header_widgets.R b/tests/testthat/test-mod_header_widgets.R index 27971f63..d32fa2ac 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,27 @@ 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") + ) + #a <- get_available_data(list("AEs" = AE_figure_data)) 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 +91,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 +116,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 +127,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 +159,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(), From 0c22c75a0c7e2dfd9fb26f55b7286202be8b3d0e Mon Sep 17 00:00:00 2001 From: LDSamson Date: Tue, 2 Dec 2025 10:06:38 +0100 Subject: [PATCH 11/37] Remove unused lines --- R/mod_header_widgets.R | 4 ---- 1 file changed, 4 deletions(-) diff --git a/R/mod_header_widgets.R b/R/mod_header_widgets.R index ff959431..c29e65a3 100644 --- a/R/mod_header_widgets.R +++ b/R/mod_header_widgets.R @@ -63,10 +63,6 @@ mod_header_widgets_server <- function( moduleServer( id, function(input, output, session){ ns <- session$ns - # for use in valueboxes for individuals: - AEvalue.individual <- reactiveVal("...") - SAEvalue.individual <- reactiveVal("...") - visit.number <- reactiveVal(".. (..%)") all_aes <- reactive({ validate(need(r$filtered_data[["Adverse events"]], "AE data missing")) From e33522022342ff5d376811e824a38eaccad5c0f9 Mon Sep 17 00:00:00 2001 From: LDSamson Date: Tue, 2 Dec 2025 10:07:03 +0100 Subject: [PATCH 12/37] Ensure expected columns are always available for timeline data --- R/app_server.R | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/R/app_server.R b/R/app_server.R index 49ac5c4d..d70d2d65 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -206,7 +206,10 @@ app_server <- function( get_timeline_data( r$filtered_data, if (!is.null(r$filtered_data[["Adverse events"]])) { - create_table(r$filtered_data[["Adverse events"]]) + create_table( + r$filtered_data[["Adverse events"]], + expected_columns = names(app_vars$items[["Adverse event"]]) + ) } else { data.frame() }, From 4442478fdd34317ea7495d181cfd885324cc5bb8 Mon Sep 17 00:00:00 2001 From: LDSamson Date: Tue, 2 Dec 2025 10:07:54 +0100 Subject: [PATCH 13/37] Make compact timeline script bit more robust for edge cases --- R/fct_figures.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/fct_figures.R b/R/fct_figures.R index 39b4ad3f..0286e32a 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)) ) + From 3060af162e34dd8b5ea117c0ff503b6f6d3537c2 Mon Sep 17 00:00:00 2001 From: LDSamson Date: Tue, 2 Dec 2025 12:07:43 +0100 Subject: [PATCH 14/37] Oops --- R/mod_header_widgets.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/mod_header_widgets.R b/R/mod_header_widgets.R index c29e65a3..b8f28fc8 100644 --- a/R/mod_header_widgets.R +++ b/R/mod_header_widgets.R @@ -91,7 +91,7 @@ mod_header_widgets_server <- function( output[["ae_box"]] <- renderUI({ req(inherits(all_AEs_reviewed(), "logical"), r$subject_id) bslib::value_box( - title = paste0("SAEs: ", with(all_aes(), AEs[subject_id == r$subject_id]) ), + 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" From f1f029b8930003229210879d5e6a42679ff11064 Mon Sep 17 00:00:00 2001 From: LDSamson Date: Tue, 2 Dec 2025 13:59:53 +0100 Subject: [PATCH 15/37] fix mod_review_config tests --- tests/testthat/test-mod_review_config.R | 10 +--------- 1 file changed, 1 insertion(+), 9 deletions(-) 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 ) From 42d96da1b88750ee2f1bfe39aebf11edd91d76b3 Mon Sep 17 00:00:00 2001 From: LDSamson Date: Tue, 2 Dec 2025 14:04:14 +0100 Subject: [PATCH 16/37] Fix mod_timeline tests --- tests/testthat/test-mod_timeline.R | 20 ++++++++------------ 1 file changed, 8 insertions(+), 12 deletions(-) diff --git a/tests/testthat/test-mod_timeline.R b/tests/testthat/test-mod_timeline.R index 7a6484c4..fa9b9ba7 100644 --- a/tests/testthat/test-mod_timeline.R +++ b/tests/testthat/test-mod_timeline.R @@ -41,11 +41,8 @@ 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) - + AE_table <- create_table(appdata[["Adverse events"]]) + timeline_data <- get_timeline_data(appdata, table_data = AE_table) testargs <- list( form_review_data = reactiveVal(rev_data), timeline_data = reactiveVal(timeline_data), @@ -78,10 +75,8 @@ 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) + AE_table <- create_table(appdata[["Adverse events"]]) + timeline_data <- get_timeline_data(appdata, table_data = AE_table) testargs <- list( form_review_data = reactiveVal(rev_data), @@ -102,12 +97,13 @@ describe( and the treatment_label set to 'custom_treatment_label', I expect the [custom_treatment_label] in the timeline JSON output.", { + AE_table <- create_table(appdata[["Adverse events"]]) timeline_data <- get_timeline_data( appdata, - apptables, + table_data = AE_table, treatment_label = "custom_treatment_label" - ) - + ) + testargs <- list( form_review_data = reactiveVal(rev_data), timeline_data = reactiveVal(timeline_data), From 604cc4a6b17c033475023669d70a25108ace77d9 Mon Sep 17 00:00:00 2001 From: LDSamson Date: Tue, 2 Dec 2025 14:07:18 +0100 Subject: [PATCH 17/37] Fix snapshot of get_available_data --- tests/testthat/_snaps/get_available_data.md | 28 ++++++++++----------- tests/testthat/test-get_available_data.R | 4 +-- 2 files changed, 15 insertions(+), 17 deletions(-) diff --git a/tests/testthat/_snaps/get_available_data.md b/tests/testthat/_snaps/get_available_data.md index 9658e18a..6f0ed9f3 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) + get_available_data(data = appdata) Output - # A tibble: 1,968 x 6 + # A tibble: 2,235 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 Urinary Incontinence 2 Adverse e~ Any visit Any visit - 10 BEL_08_885 Seizure (N: 3) 3 Adverse e~ Any visit Any visit - # i 1,958 more rows + + 1 BEL_04_772 Hypotension 1 Adverse e~ Any visit + 2 BEL_04_772 Atrial Fibrillation~ 2 Adverse e~ Any visit + 3 BEL_04_772 Tachycardia 3 Adverse e~ Any visit + 4 BEL_04_772 Urinary Tract Infec~ 4 Adverse e~ Any visit + 5 BEL_04_772 Atrial Fibrillation~ 5 Adverse e~ Any visit + 6 BEL_07_193 Atelectasis 1 Adverse e~ Any visit + 7 BEL_08_736 Hypotension 1 Adverse e~ Any visit + 8 BEL_08_885 Seizure (N: 1) 1 Adverse e~ Any visit + 9 BEL_08_885 Urinary Incontinence 2 Adverse e~ Any visit + 10 BEL_08_885 Seizure (N: 3) 3 Adverse e~ Any visit + # i 2,225 more rows diff --git a/tests/testthat/test-get_available_data.R b/tests/testthat/test-get_available_data.R index 2119c7ff..1e016723 100644 --- a/tests/testthat/test-get_available_data.R +++ b/tests/testthat/test-get_available_data.R @@ -15,9 +15,7 @@ describe( "item_group", "event_name", "event_label")) }) it("Creates the expected data frame with given random appdata input", { - expect_snapshot( - get_available_data(data = appdata) - ) + expect_snapshot(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", { From e27fe25734d0f242127b1619cf8cc0c9949a0eda Mon Sep 17 00:00:00 2001 From: LDSamson Date: Tue, 2 Dec 2025 14:28:20 +0100 Subject: [PATCH 18/37] Fix test for static overview data --- .../_snaps/get_static_overview_data.md | 36 +++++++++++-------- .../testthat/test-get_static_overview_data.R | 11 +++--- 2 files changed, 26 insertions(+), 21 deletions(-) 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-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 ) ) From 97dd2afccef1e258296d2991dee3b5a3cd48dd35 Mon Sep 17 00:00:00 2001 From: LDSamson Date: Tue, 2 Dec 2025 14:47:14 +0100 Subject: [PATCH 19/37] Update docs --- R/mod_header_widgets.R | 2 ++ R/mod_navigate_participants.R | 30 +++++++++++++------------ man/count_adverse_events.Rd | 3 ++- man/mod_header_widgets_server.Rd | 3 +++ man/mod_navigate_participants_server.Rd | 21 +++++++++-------- man/mod_navigate_participants_ui.Rd | 7 +++--- 6 files changed, 39 insertions(+), 27 deletions(-) diff --git a/R/mod_header_widgets.R b/R/mod_header_widgets.R index b8f28fc8..8ab23e1b 100644 --- a/R/mod_header_widgets.R +++ b/R/mod_header_widgets.R @@ -47,6 +47,8 @@ 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( diff --git a/R/mod_navigate_participants.R b/R/mod_navigate_participants.R index 3733782f..62bc1923 100644 --- a/R/mod_navigate_participants.R +++ b/R/mod_navigate_participants.R @@ -11,21 +11,23 @@ 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 #' diff --git a/man/count_adverse_events.Rd b/man/count_adverse_events.Rd index a2f188af..a396d52e 100644 --- a/man/count_adverse_events.Rd +++ b/man/count_adverse_events.Rd @@ -11,7 +11,8 @@ count_adverse_events( ) } \arguments{ -\item{data}{A data frame with Adverse Event data} +\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 diff --git a/man/mod_header_widgets_server.Rd b/man/mod_header_widgets_server.Rd index 9677beb8..97828137 100644 --- a/man/mod_header_widgets_server.Rd +++ b/man/mod_header_widgets_server.Rd @@ -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_navigate_participants_server.Rd b/man/mod_navigate_participants_server.Rd index 894e1ed8..4edc5002 100644 --- a/man/mod_navigate_participants_server.Rd +++ b/man/mod_navigate_participants_server.Rd @@ -7,22 +7,25 @@ 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. From 8d74c793d43fceb213595107caee541d9a8fd143 Mon Sep 17 00:00:00 2001 From: LDSamson Date: Tue, 2 Dec 2025 14:47:56 +0100 Subject: [PATCH 20/37] Update mod_common_forms test --- tests/testthat/test-mod_common_forms.R | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test-mod_common_forms.R b/tests/testthat/test-mod_common_forms.R index e06ea7bb..37d7b495 100644 --- a/tests/testthat/test-mod_common_forms.R +++ b/tests/testthat/test-mod_common_forms.R @@ -46,9 +46,7 @@ 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]])) - }) + AE_table <- create_table(appdata[["Adverse events"]]) rev_data <- get_review_data(appdata[["Adverse events"]]) |> dplyr::mutate( id = dplyr::row_number(), @@ -56,7 +54,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, table_data = AE_table) testargs <- list( form = "Adverse events", form_data = reactiveVal(appdata[["Adverse events"]]), From 4fe866117c9a10e0628d7606477123cbd1bee1e4 Mon Sep 17 00:00:00 2001 From: LDSamson Date: Tue, 2 Dec 2025 15:50:08 +0100 Subject: [PATCH 21/37] Update docs --- R/fct_appdata_summary_tables.R | 30 +++++++++++++++++------------- man/get_static_overview_data.Rd | 13 +++++++++---- 2 files changed, 26 insertions(+), 17 deletions(-) diff --git a/R/fct_appdata_summary_tables.R b/R/fct_appdata_summary_tables.R index a04df27e..c9b35e94 100644 --- a/R/fct_appdata_summary_tables.R +++ b/R/fct_appdata_summary_tables.R @@ -209,21 +209,25 @@ 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, diff --git a/man/get_static_overview_data.Rd b/man/get_static_overview_data.Rd index c330480c..908dbe3d 100644 --- a/man/get_static_overview_data.Rd +++ b/man/get_static_overview_data.Rd @@ -9,14 +9,19 @@ 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 From a3e776607659716b9da66b08aae76a62dc80db0e Mon Sep 17 00:00:00 2001 From: LDSamson Date: Tue, 2 Dec 2025 15:50:22 +0100 Subject: [PATCH 22/37] Fix test --- .../testthat/test-mod_navigate_participants.R | 42 +++++++------------ 1 file changed, 16 insertions(+), 26 deletions(-) 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()") From 68e1442ea4e85e57c6778b12376d24909913b1a7 Mon Sep 17 00:00:00 2001 From: LDSamson Date: Tue, 2 Dec 2025 15:52:49 +0100 Subject: [PATCH 23/37] More functional function argument verifications --- R/fct_appdata_summary_tables.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/fct_appdata_summary_tables.R b/R/fct_appdata_summary_tables.R index c9b35e94..26c9394e 100644 --- a/R/fct_appdata_summary_tables.R +++ b/R/fct_appdata_summary_tables.R @@ -167,7 +167,7 @@ get_available_data <- function( data, form_repeat_name = "N" ){ - stopifnot(is.list(data), 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") @@ -233,7 +233,7 @@ get_static_overview_data <- function( 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 <- with(available_data, available_data[ From 1544f0127f318d5772c8586f37da31ba7e98e91e Mon Sep 17 00:00:00 2001 From: LDSamson Date: Tue, 2 Dec 2025 16:08:53 +0100 Subject: [PATCH 24/37] Fix test --- .../test-mod_review_config_fct_helpers.R | 19 ++++--------------- 1 file changed, 4 insertions(+), 15 deletions(-) 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" ) }) From a616b3137b5e75df6ef6320dc426643eca88f2a5 Mon Sep 17 00:00:00 2001 From: LDSamson Date: Tue, 2 Dec 2025 16:40:57 +0100 Subject: [PATCH 25/37] Update docs --- R/fct_appdata_summary_tables.R | 4 ++-- man/get_timeline_data.Rd | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/fct_appdata_summary_tables.R b/R/fct_appdata_summary_tables.R index 26c9394e..2586c148 100644 --- a/R/fct_appdata_summary_tables.R +++ b/R/fct_appdata_summary_tables.R @@ -4,8 +4,8 @@ #' 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 table_data A data frame with table data needed for the timeline. +#' Created with [create_table()]. Expected to have Adverse event data. #' @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 diff --git a/man/get_timeline_data.Rd b/man/get_timeline_data.Rd index 2dfa34de..00965df8 100644 --- a/man/get_timeline_data.Rd +++ b/man/get_timeline_data.Rd @@ -15,8 +15,8 @@ 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{table_data}{A data frame with table data needed for the timeline. +Created with \code{\link[=create_table]{create_table()}}. Expected to have Adverse event data.} \item{timeline_cols}{Character vector with the name of the columns of the output data frame.} From be485158fb1a9a1ce17587baf2841a1599b4ee49 Mon Sep 17 00:00:00 2001 From: LDSamson Date: Tue, 2 Dec 2025 16:41:10 +0100 Subject: [PATCH 26/37] Bump version and add news. --- DESCRIPTION | 2 +- NEWS.md | 1 + inst/golem-config.yml | 2 +- 3 files changed, 3 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 681f2b59..7575d2d4 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: clinsight Title: ClinSight -Version: 0.3.0.9004 +Version: 0.3.0.9005 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 4e731ee3..cb473ded 100644 --- a/NEWS.md +++ b/NEWS.md @@ -12,6 +12,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/inst/golem-config.yml b/inst/golem-config.yml index ada744a6..608c8741 100644 --- a/inst/golem-config.yml +++ b/inst/golem-config.yml @@ -1,6 +1,6 @@ default: golem_name: clinsight - golem_version: 0.3.0.9004 + golem_version: 0.3.0.9005 app_prod: no user_identification: test_user study_data: !expr clinsight::clinsightful_data From 789edbc6e75481e6a0da5e36a243a5a6394a3d39 Mon Sep 17 00:00:00 2001 From: LDSamson Date: Wed, 3 Dec 2025 08:42:22 +0100 Subject: [PATCH 27/37] improve get_timeline_data --- R/app_server.R | 25 ++++------ R/fct_appdata_summary_tables.R | 46 +++++++++++++------ tests/testthat/_snaps/get_available_data.md | 26 +++++------ .../test-fct_appdata_summary_tables.R | 44 +++++++++++------- tests/testthat/test-get_available_data.R | 3 +- tests/testthat/test-mod_common_forms.R | 3 +- tests/testthat/test-mod_timeline.R | 8 +--- 7 files changed, 88 insertions(+), 67 deletions(-) diff --git a/R/app_server.R b/R/app_server.R index d70d2d65..3e563699 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -56,6 +56,16 @@ app_server <- function( with(meta$items_expanded, item_name[item_group == "General"]) ) ) + + # For timeline data + timeline_data <- reactive({ + get_timeline_data( + r$filtered_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)), @@ -201,21 +211,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, - if (!is.null(r$filtered_data[["Adverse events"]])) { - create_table( - r$filtered_data[["Adverse events"]], - expected_columns = names(app_vars$items[["Adverse event"]]) - ) - } else { - data.frame() - }, - 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"]) diff --git a/R/fct_appdata_summary_tables.R b/R/fct_appdata_summary_tables.R index 2586c148..3093fd2b 100644 --- a/R/fct_appdata_summary_tables.R +++ b/R/fct_appdata_summary_tables.R @@ -16,14 +16,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.data.frame(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,26 +41,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(nrow(table_data) == 0){ + ## Get AE data + if(is.null(data[["Adverse events"]]) || nrow(data[["Adverse events"]]) == 0){ AE_timedata <- SAE_data <- data.frame() } else{ + 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"]])) |> @@ -170,10 +188,10 @@ get_available_data <- function( 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_name", "event_label", "event_date") if(length(data) == 0) { warning("Empty list of data provided") - return(add_missing_columns(data.frame(), c(selector_cols, "n"))) + return(add_missing_columns(data.frame(), selector_cols)) } study_event_selectors <- lapply( data, diff --git a/tests/testthat/_snaps/get_available_data.md b/tests/testthat/_snaps/get_available_data.md index 6f0ed9f3..bccac4d4 100644 --- a/tests/testthat/_snaps/get_available_data.md +++ b/tests/testthat/_snaps/get_available_data.md @@ -3,18 +3,18 @@ Code get_available_data(data = appdata) Output - # A tibble: 2,235 x 6 - subject_id item_name form_repeat item_group event_name event_label - - 1 BEL_04_772 Hypotension 1 Adverse e~ Any visit - 2 BEL_04_772 Atrial Fibrillation~ 2 Adverse e~ Any visit - 3 BEL_04_772 Tachycardia 3 Adverse e~ Any visit - 4 BEL_04_772 Urinary Tract Infec~ 4 Adverse e~ Any visit - 5 BEL_04_772 Atrial Fibrillation~ 5 Adverse e~ Any visit - 6 BEL_07_193 Atelectasis 1 Adverse e~ Any visit - 7 BEL_08_736 Hypotension 1 Adverse e~ Any visit - 8 BEL_08_885 Seizure (N: 1) 1 Adverse e~ Any visit - 9 BEL_08_885 Urinary Incontinence 2 Adverse e~ Any visit - 10 BEL_08_885 Seizure (N: 3) 3 Adverse e~ Any visit + # 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/test-fct_appdata_summary_tables.R b/tests/testthat/test-fct_appdata_summary_tables.R index f5d67948..fafa6887 100644 --- a/tests/testthat/test-fct_appdata_summary_tables.R +++ b/tests/testthat/test-fct_appdata_summary_tables.R @@ -7,12 +7,8 @@ describe("get_timeline_data works", { ) |> get_appdata() appvars <- get_meta_vars(appdata) - - ae_tables <- create_table( - appdata[["Adverse events"]], - expected_columns = names(appvars$items[["Adverse events"]]) - ) - output <- get_timeline_data(appdata, ae_tables) + available_data <- get_available_data(appdata) + output <- get_timeline_data(appdata, available_data) expect_true(is.data.frame(output)) expect_equal( names(output), @@ -28,33 +24,49 @@ describe("get_timeline_data works", { ) |> get_appdata() appvars <- get_meta_vars(appdata) - ae_tables <- create_table( - appdata[["Adverse events"]], - expected_columns = names(appvars$items[["Adverse events"]]) - ) + 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"], ae_tables) + 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"], ae_tables) + 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"], ae_tables) + 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"], ae_tables), + output <- get_timeline_data(appdata["Gener"]), "No data found" ) - output <- get_timeline_data(appdata["Gener"], ae_tables) |> - 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 1e016723..01a7d814 100644 --- a/tests/testthat/test-get_available_data.R +++ b/tests/testthat/test-get_available_data.R @@ -12,7 +12,8 @@ describe( 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")) + "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)) diff --git a/tests/testthat/test-mod_common_forms.R b/tests/testthat/test-mod_common_forms.R index 37d7b495..091872d7 100644 --- a/tests/testthat/test-mod_common_forms.R +++ b/tests/testthat/test-mod_common_forms.R @@ -46,7 +46,6 @@ describe( ) |> get_appdata() appvars <- get_meta_vars(appdata) - AE_table <- create_table(appdata[["Adverse events"]]) rev_data <- get_review_data(appdata[["Adverse events"]]) |> dplyr::mutate( id = dplyr::row_number(), @@ -54,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, table_data = AE_table) + timeline_data <- get_timeline_data(appdata) testargs <- list( form = "Adverse events", form_data = reactiveVal(appdata[["Adverse events"]]), diff --git a/tests/testthat/test-mod_timeline.R b/tests/testthat/test-mod_timeline.R index fa9b9ba7..091a6e67 100644 --- a/tests/testthat/test-mod_timeline.R +++ b/tests/testthat/test-mod_timeline.R @@ -41,8 +41,7 @@ describe( status = sample(c("new", "old", "updated"), dplyr::n(), replace = TRUE) ) appvars <- get_meta_vars(appdata) - AE_table <- create_table(appdata[["Adverse events"]]) - timeline_data <- get_timeline_data(appdata, table_data = AE_table) + timeline_data <- get_timeline_data(appdata) testargs <- list( form_review_data = reactiveVal(rev_data), timeline_data = reactiveVal(timeline_data), @@ -75,8 +74,7 @@ describe( status = sample(c("new", "old", "updated"), dplyr::n(), replace = TRUE) ) appvars <- get_meta_vars(appdata) - AE_table <- create_table(appdata[["Adverse events"]]) - timeline_data <- get_timeline_data(appdata, table_data = AE_table) + timeline_data <- get_timeline_data(appdata) testargs <- list( form_review_data = reactiveVal(rev_data), @@ -97,10 +95,8 @@ describe( and the treatment_label set to 'custom_treatment_label', I expect the [custom_treatment_label] in the timeline JSON output.", { - AE_table <- create_table(appdata[["Adverse events"]]) timeline_data <- get_timeline_data( appdata, - table_data = AE_table, treatment_label = "custom_treatment_label" ) From 49f4ea93e7e11820ec4d6d8bc3eff2619261701a Mon Sep 17 00:00:00 2001 From: LDSamson Date: Wed, 3 Dec 2025 08:42:34 +0100 Subject: [PATCH 28/37] Update docs --- R/fct_appdata_summary_tables.R | 8 ++++++-- man/get_timeline_data.Rd | 14 +++++++++++--- 2 files changed, 17 insertions(+), 5 deletions(-) diff --git a/R/fct_appdata_summary_tables.R b/R/fct_appdata_summary_tables.R index 3093fd2b..c5090703 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 data frame with table data needed for the timeline. -#' Created with [create_table()]. Expected to have Adverse event data. +#' @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 diff --git a/man/get_timeline_data.Rd b/man/get_timeline_data.Rd index 00965df8..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 data frame with table data needed for the timeline. -Created with \code{\link[=create_table]{create_table()}}. Expected to have Adverse event data.} +\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.} From 813143eca9ef52febf5931b8910d393d5802b721 Mon Sep 17 00:00:00 2001 From: LDSamson Date: Wed, 3 Dec 2025 08:50:03 +0100 Subject: [PATCH 29/37] move timeline_data to old location --- R/app_server.R | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/R/app_server.R b/R/app_server.R index 3e563699..e14de0c5 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -57,15 +57,6 @@ app_server <- function( ) ) - # For timeline data - timeline_data <- reactive({ - get_timeline_data( - r$filtered_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)), @@ -212,6 +203,15 @@ app_server <- function( }) outputOptions(output, "form_level_review", suspendWhenHidden = FALSE) + # For timeline data + timeline_data <- reactive({ + get_timeline_data( + r$filtered_data, + available_data = available_data, + 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"]) lapply(common_forms, \(i){ From f0639551d2babc5f4aef0f88532e8099c50895db Mon Sep 17 00:00:00 2001 From: LDSamson Date: Fri, 5 Dec 2025 15:52:49 +0100 Subject: [PATCH 30/37] Convert timeline_data to a standard data frame instead of a reactive --- R/app_server.R | 16 +++++++--------- R/mod_common_forms.R | 7 +++---- R/mod_timeline.R | 6 +++--- man/mod_common_forms_server.Rd | 5 ++--- man/mod_timeline_server.Rd | 5 ++--- tests/testthat/test-mod_common_forms.R | 6 +++--- tests/testthat/test-mod_timeline.R | 12 ++++++------ 7 files changed, 26 insertions(+), 31 deletions(-) diff --git a/R/app_server.R b/R/app_server.R index e14de0c5..b3e278cd 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -57,6 +57,13 @@ app_server <- function( ) ) + # 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)), @@ -203,15 +210,6 @@ app_server <- function( }) outputOptions(output, "form_level_review", suspendWhenHidden = FALSE) - # For timeline data - timeline_data <- reactive({ - get_timeline_data( - r$filtered_data, - available_data = available_data, - 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"]) lapply(common_forms, \(i){ 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_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/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_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/test-mod_common_forms.R b/tests/testthat/test-mod_common_forms.R index 091872d7..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.", { @@ -61,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], @@ -115,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_timeline.R b/tests/testthat/test-mod_timeline.R index 091a6e67..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 , { @@ -44,7 +44,7 @@ describe( 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 @@ -54,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,7 +78,7 @@ describe( 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', @@ -102,7 +102,7 @@ describe( 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, { From dc708eff40356cd1b5d74fd28f9ca7a0e7fa54ac Mon Sep 17 00:00:00 2001 From: LDSamson Date: Sat, 6 Dec 2025 11:55:29 +0100 Subject: [PATCH 31/37] Ensure all_ids never has duplicated ids --- R/mod_header_widgets_fct_helpers.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/mod_header_widgets_fct_helpers.R b/R/mod_header_widgets_fct_helpers.R index 757e8d66..ec0019c1 100644 --- a/R/mod_header_widgets_fct_helpers.R +++ b/R/mod_header_widgets_fct_helpers.R @@ -21,8 +21,8 @@ count_adverse_events <- function( }) } stopifnot("One or more required columns are missing" = all(c(key_columns, "item_value") %in% names(data))) - stopifnot(is.character(all_ids %||% "")) - all_ids <- c(all_ids, unique(data[["subject_id"]])) + 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( @@ -38,7 +38,7 @@ count_adverse_events <- function( dplyr::mutate( item_value = ifelse(is.na(item_value), "No", item_value) ) - all_aes <- data.frame(subject_id = unique(all_ids)) |> + all_aes <- data.frame(subject_id = all_ids) |> dplyr::left_join( ae_data, by = "subject_id" From 9d51f2104c419ffbd496c663f72c9291f38ff727 Mon Sep 17 00:00:00 2001 From: LDSamson Date: Sat, 6 Dec 2025 11:58:28 +0100 Subject: [PATCH 32/37] Ensure item names are never converted to factor level numbers --- R/fct_appdata_summary_tables.R | 7 +++---- tests/testthat/test-get_available_data.R | 18 ++++++++++++++++-- 2 files changed, 19 insertions(+), 6 deletions(-) diff --git a/R/fct_appdata_summary_tables.R b/R/fct_appdata_summary_tables.R index c5090703..86b90e17 100644 --- a/R/fct_appdata_summary_tables.R +++ b/R/fct_appdata_summary_tables.R @@ -207,10 +207,9 @@ get_available_data <- function( } x[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() # To uniquely identify events with the same name (mostly in common_forms): diff --git a/tests/testthat/test-get_available_data.R b/tests/testthat/test-get_available_data.R index 01a7d814..dd0d3455 100644 --- a/tests/testthat/test-get_available_data.R +++ b/tests/testthat/test-get_available_data.R @@ -11,8 +11,22 @@ describe( it("Creates a data frame with the correct columns per individual. ", { 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("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", { From a47479e8d56a01534a7cbdb550ab76f90ceebef6 Mon Sep 17 00:00:00 2001 From: LDSamson Date: Sat, 6 Dec 2025 11:59:35 +0100 Subject: [PATCH 33/37] Ensure no errors are thrown in edge cases when using get_available_data --- R/fct_appdata_summary_tables.R | 14 ++++++++++++-- tests/testthat/_snaps/get_available_data.md | 2 +- tests/testthat/test-get_available_data.R | 10 +++++++++- 3 files changed, 22 insertions(+), 4 deletions(-) diff --git a/R/fct_appdata_summary_tables.R b/R/fct_appdata_summary_tables.R index 86b90e17..f2158273 100644 --- a/R/fct_appdata_summary_tables.R +++ b/R/fct_appdata_summary_tables.R @@ -201,17 +201,27 @@ get_available_data <- function( data, \(x){ name_vars <- c("Name", "AE Name", "CP Name", "MH Name", "CM Name") + if (any(!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) + ) + } if ( any(unique(x$item_name) %in% name_vars)){ x <- x[x$item_name %in% name_vars, ] |> dplyr::mutate(item_name = item_value) } - x[c(selector_cols)] |> + x[!is.na(x$item_name), c(selector_cols)] |> dplyr::distinct() |> 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( diff --git a/tests/testthat/_snaps/get_available_data.md b/tests/testthat/_snaps/get_available_data.md index bccac4d4..88e7f0ea 100644 --- a/tests/testthat/_snaps/get_available_data.md +++ b/tests/testthat/_snaps/get_available_data.md @@ -1,7 +1,7 @@ # 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) + dplyr::as_tibble(get_available_data(data = appdata)) Output # A tibble: 2,235 x 7 subject_id item_name form_repeat item_group event_name event_label event_date diff --git a/tests/testthat/test-get_available_data.R b/tests/testthat/test-get_available_data.R index dd0d3455..2c4fa278 100644 --- a/tests/testthat/test-get_available_data.R +++ b/tests/testthat/test-get_available_data.R @@ -30,7 +30,7 @@ describe( "event_date")) }) it("Creates the expected data frame with given random appdata input", { - expect_snapshot(get_available_data(data = appdata)) + 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", { @@ -75,6 +75,14 @@ describe( 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", { From 82dc224f999a2a4a5f1ec5508a9abe196c5f83a2 Mon Sep 17 00:00:00 2001 From: LDSamson Date: Sat, 6 Dec 2025 12:01:45 +0100 Subject: [PATCH 34/37] remove commented out code used for development --- tests/testthat/test-mod_header_widgets.R | 1 - 1 file changed, 1 deletion(-) diff --git a/tests/testthat/test-mod_header_widgets.R b/tests/testthat/test-mod_header_widgets.R index d32fa2ac..1eadd0e7 100644 --- a/tests/testthat/test-mod_header_widgets.R +++ b/tests/testthat/test-mod_header_widgets.R @@ -77,7 +77,6 @@ describe( event_name = "", event_label = factor("SCR") ) - #a <- get_available_data(list("AEs" = AE_figure_data)) testargs <- list( r = reactiveValues( filtered_data = list("Adverse events" = AE_figure_data) From c38dd4afa5a0ced5320722303ec93769206086ff Mon Sep 17 00:00:00 2001 From: LDSamson Date: Sat, 6 Dec 2025 12:07:09 +0100 Subject: [PATCH 35/37] Bit easier to follow logic --- R/fct_appdata_summary_tables.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/fct_appdata_summary_tables.R b/R/fct_appdata_summary_tables.R index f2158273..6761bfb4 100644 --- a/R/fct_appdata_summary_tables.R +++ b/R/fct_appdata_summary_tables.R @@ -201,7 +201,7 @@ get_available_data <- function( data, \(x){ name_vars <- c("Name", "AE Name", "CP Name", "MH Name", "CM Name") - if (any(!selector_cols %in% names(x))) { + if (!all(selector_cols %in% names(x))) { x <- add_missing_columns(x, selector_cols) |> dplyr::mutate( event_date = as.Date(event_date), From 99d586f6affa5b5e8f145d949b3a38ec52964607 Mon Sep 17 00:00:00 2001 From: LDSamson Date: Fri, 12 Dec 2025 15:02:07 +0100 Subject: [PATCH 36/37] Bump version --- DESCRIPTION | 2 +- inst/golem-config.yml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 7575d2d4..f1285b07 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: clinsight Title: ClinSight -Version: 0.3.0.9005 +Version: 0.3.0.9006 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/inst/golem-config.yml b/inst/golem-config.yml index 608c8741..11f27c38 100644 --- a/inst/golem-config.yml +++ b/inst/golem-config.yml @@ -1,6 +1,6 @@ default: golem_name: clinsight - golem_version: 0.3.0.9005 + golem_version: 0.3.0.9006 app_prod: no user_identification: test_user study_data: !expr clinsight::clinsightful_data From 206aa2c671b3e66d7203f85eb45d19fcfa2161ea Mon Sep 17 00:00:00 2001 From: LDSamson Date: Mon, 22 Dec 2025 09:14:28 +0100 Subject: [PATCH 37/37] Bump version --- DESCRIPTION | 2 +- inst/golem-config.yml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) 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/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