Merge pull request #152 from openpharma/ls_improve_timeline

Improve timeline
openpharma · Jan 30, 2025 · 044a2c0 · 044a2c0
2 parents 7440824 + 61aea9b
commit 044a2c0
Show file tree

Hide file tree

Showing 34 changed files with 507 additions and 216 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: clinsight
 Title: ClinSight
-Version: 0.1.1.9018
+Version: 0.1.1.9019
 Authors@R: c(
     person("Leonard Daniël", "Samson", , "[email protected]", role = c("cre", "aut"),
            comment = c(ORCID = "0000-0002-6252-7639")),
@@ -30,6 +30,7 @@ Imports:
     ggplot2,
     golem,
     htmltools,
+    htmlwidgets,
     plotly,
     readr,
     readxl,

diff --git a/NEWS.md b/NEWS.md
@@ -14,6 +14,7 @@
 - Changed the legend to display 'significance pending' instead of 'significance unknown'.
 - Added `Excel` download button to Queries table & patient listings that need review.
 - (For developers) From now on,the new Chrome headless browser mode will be used for `shinytest2` tests so that unit tests can be run with Chrome v132. 
+- The interactive timeline now has more consistent labels, will center an item on click, and has customizable treatment labels (by setting `settings$treatment_label` in the metadata).
 
 ## Bug fixes
 

diff --git a/R/app_server.R b/R/app_server.R
@@ -210,7 +210,9 @@ app_server <- function(
   lapply(common_forms, \(x){
     mod_common_forms_server(
       id = paste0("cf_", simplify_string(x)), r = r, form = x,
-      form_items = app_vars$items[[x]], table_names = app_vars$table_names
+      form_items = app_vars$items[[x]], 
+      table_names = app_vars$table_names, 
+      timeline_treatment_label = meta$settings$treatment_label
     ) 
   }) |>
     unlist(recursive = FALSE)

diff --git a/R/data.R b/R/data.R
@@ -30,6 +30,17 @@
 #'   here is `review_required`, which can be used to specify whether review is
 #'   required for a form. Will default to TRUE for each form it is unset for a
 #'   form.
+#'  - `settings` contains custom `ClinSight` settings. Currently these are available:
+#'   1. Settings for adjusting and customizing study data when merging with
+#'   metadata using [merge_meta_with_data()]. If a custom function name is added
+#'   here, the function will run at the described moment of the merging process
+#'   (before or after merging or data pivoting):
+#'      - `pre_merge_fns`
+#'      - `pre_pivot_fns`
+#'      - `post_pivot_fns`
+#'      - `post_merge_fns`
+#'   2. Other (misc.) settings:
+#'      - `treatment_label` to set the label for the treatments in the interactive timeline. Defaults to "💊 Tₓ".
 #'
 #' @source Can be created with an Excel file. The Excel file format is chosen so
 #'   that the metadata can be changed easily per study. See

diff --git a/R/fct_appdata_summary_tables.R b/R/fct_appdata_summary_tables.R
@@ -6,8 +6,10 @@
 #' @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 timeline_cols Character vector with the name of the columns of the 
-#'  output data frame.
+#' @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
+#'   treatment item in the timeline.
 #'
 #' @return A data frame with timeline data.
 #' @export
@@ -16,15 +18,18 @@ get_timeline_data <- function(
     data, 
     table_data, 
     timeline_cols =  c("subject_id", "event_name", "form_repeat", "item_group", 
-                       "start", "group", "end", "title", "style", "id", "order")
-    ){
+                       "start", "group", "end", "title", "className", "id", "order"),
+    treatment_label = "\U1F48A T\U2093"
+){
   stopifnot(is.list(data), is.list(table_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(
       as.data.frame(matrix(ncol = length(timeline_cols))),
       timeline_cols
-      ) |> 
+    ) |>
       dplyr::rename("content" = "event_name")
   })
   study_event_data <- if(is.null(data) ){
@@ -38,7 +43,10 @@ get_timeline_data <- function(
         event_name != "Any visit"
       ) |> 
       dplyr::distinct(subject_id, event_name, start = event_date) |> 
-      dplyr::mutate(group = "Visit")
+      dplyr::mutate(
+        group = "Visit",
+        title = paste0(start, " | ", event_name)
+      )
   }
 
   if(is.null(table_data$`Adverse events`)){
@@ -51,12 +59,19 @@ get_timeline_data <- function(
         event_name = `Name`,
         item_group = "Adverse events",
         group  = "Adverse event",
-        `end date` = ifelse(`end date` == `start date`, NA_character_ , as.character(`end date`)) |> 
+        `end date` = ifelse(
+          `end date` == `start date`, 
+          NA_character_ , 
+          as.character(`end date`)
+        ) |> 
           as.character(),
         start = clean_dates(`start date`),
         end = clean_dates(`end date`),
-        style = "background-color: #d47500;",
-        title = `Name`
+        className = "bg-warning",
+        title = paste0(
+          start, ifelse(!is.na(end), paste0(" - ", end), ""), 
+          " | ", `Name`
+        )
       )  
 
     SAE_data <- table_data$`Adverse events` |> 
@@ -75,35 +90,56 @@ get_timeline_data <- function(
                        clean_dates(`SAE Start date`)) |> 
           as.Date(),
         end = clean_dates(`SAE End date`),
-        #end = clean_dates(ifelse(end == start, NA , end)),
-        style = "background-color: #cd0200;",
-        title = `Name`
+        className = "bg-danger",
+        title = paste0(
+          start, 
+          ifelse(!is.na(end), paste0(" - ", end), ""), 
+          " | ", 
+          `Name`
+        )
       )
   } 
 
   drug_data <- if(is.null(data$General)){
     data.frame()
   } else{
-    data$General |> 
-      dplyr::filter(item_name %in% c("DrugAdminDate", "DrugDiscontDate")) |> 
+    df_drug_admin <- data$General[
+      data$General$item_name %in% c("DrugAdminDate", "DrugAdminDose"), 
+    ] |> 
+      tidyr::pivot_wider(names_from = item_name, values_from = item_value) |> 
+      add_missing_columns(c("DrugAdminDate", "DrugAdminDose")) |> 
       dplyr::mutate(
-        event_name = gsub("DrugAdminDate", "Treatment", item_name),
-        event_name = gsub(" date", "", event_name),
+        event_name = treatment_label,
         group = "Events",
-        start = clean_dates(item_value)
+        start = clean_dates(DrugAdminDate),
+        title = paste0(
+          DrugAdminDate, " | ",
+          "Treatment \n", 
+          "Dose: ", ifelse(is.na(DrugAdminDose), "?", DrugAdminDose)
+        )
+      ) |> 
+      dplyr::select(-dplyr::all_of(c("DrugAdminDate", "DrugAdminDose")))
+    df_discont <- data$General[
+      data$General$item_name %in% c("DrugDiscontDate"), 
+    ] |> 
+      dplyr::mutate(
+        event_name = "Drug discontinuation",
+        group = "Events",
+        start = clean_dates(item_value),
+        title = paste0(start, " | ", "Treatment discontinued")
       )
+    dplyr::bind_rows(df_drug_admin, df_discont)
   }
 
   df <- dplyr::bind_rows(study_event_data, AE_timedata, SAE_data, drug_data) |> 
     add_missing_columns(timeline_cols) |> 
     dplyr::mutate(
       id = dplyr::row_number(),
+      className = ifelse(is.na(className), "bg-light", className),
       group = factor(group, levels = c("SAE", "Adverse event", "Events", "Visit")),
-      style = ifelse(!is.na(style), paste0(style, "line-height: 0.8; border-radius: 6px;"),
-                     "line-height: 0.8; border-radius: 6px;"),
       order = as.numeric(group)
     ) |> 
-    dplyr::filter(!is.na(subject_id)) |> 
+    dplyr::filter(!is.na(subject_id), !is.na(start)) |> 
     dplyr::select(dplyr::all_of(timeline_cols)) |> 
     dplyr::rename("content" = "event_name")
   df
@@ -137,7 +173,7 @@ get_available_data <- function(
     tables, 
     all_forms,
     form_repeat_name = "N"
-    ){
+){
   stopifnot(is.list(data), is.list(tables), is.character(form_repeat_name))
   if(identical(form_repeat_name, character(0))){form_repeat_name <- "N"}
   study_event_selectors <- lapply(
@@ -149,7 +185,7 @@ get_available_data <- function(
           dplyr::select(
             dplyr::all_of(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]] |> 
@@ -162,7 +198,7 @@ get_available_data <- function(
         dplyr::arrange(
           subject_id, 
           factor(event_name, levels = order_string(event_name))
-          )
+        )
     }) |> 
     dplyr::bind_rows()
   # To uniquely identify events with the same name (mostly in common_forms):
@@ -220,7 +256,7 @@ get_static_overview_data <- function(
   create_table.general(
     data[["General"]], 
     expected_columns = expected_general_columns
-    ) |>
+  ) |>
     dplyr::select(tidyr::all_of("subject_id"), tidyr::any_of(c("status", "WHO.classification", "Age", "Sex"))) |>
     dplyr::left_join(visits, by = "subject_id")
 }
diff --git a/R/fct_data_helpers.R b/R/fct_data_helpers.R
@@ -33,7 +33,13 @@ get_metadata <- function(
   meta$settings <- meta$settings |> 
     lapply(\(x) as.character(na.omit(x))) |> 
     Filter(f = length)
-
+
+  meta$settings$treatment_label <- meta$settings$treatment_label %||% "\U1F48A T\U2093" |> 
+    # So that raw Unicode will be converted correctly:
+    sprintf(fmt = '"%s"') |>
+    str2expression() |>
+    as.character()
+
   if(length(expand_tab_items[nchar(expand_tab_items) > 0 ] ) == 0) return(meta)
   if("items_expanded" %in% names(meta)) warning({
     "Table 'items_expanded' already present. The old table will be overwritten."

diff --git a/R/global.R b/R/global.R
@@ -115,7 +115,12 @@ utils::globalVariables(
     "form_type",
     "id",
     "o_reviewed",
-    "row_id"
+    "row_id",
+    "start",
+    "end",
+    "className",
+    "DrugAdminDate",
+    "DrugAdminDose"
   )
 )
 

diff --git a/R/mod_common_forms.R b/R/mod_common_forms.R
@@ -71,6 +71,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_treatment_label Character vector with the label to use for
+#'   the treatment items in the interactive timeline.
 #'
 #' @seealso [mod_common_forms_ui()], [mod_timeline_ui()],
 #'   [mod_timeline_server()], [mod_review_form_tbl_ui()],
@@ -83,7 +85,8 @@ mod_common_forms_server <- function(
     form_items,
     id_item = c("subject_id", "event_name", "item_group", 
                 "form_repeat", "item_name"),
-    table_names = NULL
+    table_names = NULL,
+    timeline_treatment_label = "\U1F48A T\U2093"
 ){
   stopifnot(is.reactivevalues(r))
   stopifnot(is.character(form), length(form) == 1)
@@ -148,7 +151,12 @@ mod_common_forms_server <- function(
     if (form == "Adverse events")
       mod_review_form_tbl_server("review_form_SAE_tbl", r, SAE_data, form, reactive(input$show_all_data), table_names, "Serious Adverse Events")
 
-    mod_timeline_server("timeline_fig", r = r, form = form)
+    mod_timeline_server(
+      "timeline_fig", 
+      r = r, 
+      form = form, 
+      treatment_label = timeline_treatment_label
+      )
 
   })
 }

diff --git a/R/mod_timeline.R b/R/mod_timeline.R
@@ -11,28 +11,41 @@ mod_timeline_ui <- function(id){
 }
 
 #' Interactive timeline - Shiny module Server
-#' 
-#' A shiny module. Creates an interactive timeline. 
-#' Used to provide a quick overview of adverse events, severe adverse events, 
-#' and study activities such as Investigational Product administration. 
-#' Helpful to judge whether for example an event is related to an Investigational 
-#' Product.
 #'
-#' @param id Character string, used to connect the module UI with the module Server. 
-#' @param r Common reactive values. Used to access the data frames `review_data`, 
-#' `filtered_tables`, and the active `subject_id`. `review_data` will be used to 
-#' minimize data points on the timeline that are already reviewed.
-#' @param form A character vector, the form in which the timeline needs to be embedded.
-#' Currently, only the form 'Adverse events' is supported.
+#' A shiny module. Creates an interactive timeline. Used to provide a quick
+#' overview of adverse events, severe adverse events, and study activities such
+#' as Investigational Product administration. Helpful to judge whether for
+#' example an event is related to an Investigational Product.
+#'
+#' @param id Character string, used to connect the module UI with the module
+#'   Server.
+#' @param r Common reactive values. Used to access the data frames
+#'   `review_data`, `filtered_tables`, and the active `subject_id`.
+#'   `review_data` will be used to minimize data points on the timeline that are
+#'   already reviewed.
+#' @param form A character vector, the form in which the timeline needs to be
+#'   embedded. Currently, only the form 'Adverse events' is supported.
+#' @param treatment_label Character with the treatment label to use. Defaults to
+#'   "💊 Tₓ" if missing.
 #'
-#' @seealso [mod_timeline_ui()], [mod_common_forms_ui()], [mod_common_forms_server()]
-mod_timeline_server <- function(id, r, form){
+#' @seealso [mod_timeline_ui()], [mod_common_forms_ui()],
+#'   [mod_common_forms_server()]
+mod_timeline_server <- function(id, r, form, treatment_label = "\U1F48A T\U2093"){
+  stopifnot(is.reactivevalues(r))
+  stopifnot(is.character(form), length(form) == 1)
+  stopifnot(is.null(treatment_label) || is.character(treatment_label))
+  treatment_label <- treatment_label %||% "\U1F48A T\U2093"
+
   moduleServer( id, function(input, output, session){
     ns <- session$ns
 
     timeline_data <- reactive({
       req(form == "Adverse events")
-      get_timeline_data(r$filtered_data, r$filtered_tables)
+      get_timeline_data(
+        r$filtered_data, 
+        r$filtered_tables, 
+        treatment_label = treatment_label
+      )
     })
     timeline_data_active <- reactive({
       req(timeline_data())
@@ -51,12 +64,11 @@ mod_timeline_server <- function(id, r, form){
       df <- with(timeline_data(), timeline_data()[subject_id == r$subject_id, ]) |> 
         dplyr::left_join(review_active, by = c("subject_id", "form_repeat", "item_group")) |> 
         dplyr::mutate(
-          content = ifelse(is.na(needs_review), content,
-                           ifelse(needs_review, content, NA_character_)),
-          style = ifelse(is.na(needs_review), style,
-                         ifelse(needs_review, style,
-                                paste0(style, "; line-height: 0.1; border-radius: 20px;")
-                         ))
+          className = ifelse(
+            is.na(needs_review), 
+            className,
+            ifelse(needs_review, className, "bg-secondary")
+            )
         )
       df
     })
@@ -65,6 +77,10 @@ mod_timeline_server <- function(id, r, form){
       shinyjs::hide("timeline")
     }
 
+    observeEvent(input$timeline_selected, {
+      timevis::centerItem("timeline", input$timeline_selected)
+    })
+
     output[["timeline"]] <-  timevis::renderTimevis({
       req(form == "Adverse events")
       timevis::timevis(
@@ -76,9 +92,9 @@ mod_timeline_server <- function(id, r, form){
             "content" = .data[["group"]]) |>
           dplyr::distinct(id, content, order),
         options = list(zoomable = FALSE)
-      )
-    })
-
+      ) |> 
+        htmlwidgets::onRender("timelineRedrawCustom")
+    }) 
   })
 }
 

diff --git a/data-raw/metadata.xlsx b/data-raw/metadata.xlsx
diff --git a/data/metadata.rda b/data/metadata.rda