From 6a619e18864503e62c96a19b4bb94171ccc6e72a Mon Sep 17 00:00:00 2001 From: gm-ebs-ext <177268999+gm-ebs-ext@users.noreply.github.com> Date: Fri, 3 Jan 2025 22:50:02 +0000 Subject: [PATCH 01/15] add js for row double click and backup progress. --- DESCRIPTION | 2 +- R/helpers.R | 31 +++++++++++++++++++++ R/mod_listings.R | 65 +++++++++++++++++++++++++++++++++---------- man/check_receiver.Rd | 21 ++++++++++++++ man/listings_UI.Rd | 15 +++++++++- 5 files changed, 118 insertions(+), 16 deletions(-) create mode 100644 man/check_receiver.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 3580a5c..e3caaee 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -41,7 +41,7 @@ Imports: shinyjs (>= 2.1.0), shinyWidgets (>= 0.8.0), tibble (>= 3.2.1) -RoxygenNote: 7.3.1 +RoxygenNote: 7.3.2 Roxygen: list(markdown = TRUE) Remotes: boehringer-ingelheim/dv.manager@main VignetteBuilder: knitr diff --git a/R/helpers.R b/R/helpers.R index d9ebbb1..ada5e12 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -247,3 +247,34 @@ set_up_datatable <- function(dataset, selected_cols, pagination) { ) ) } + +#' Produce a warning for non-available receiver names +#' +#' @param receiver_id Character string defining the module that should receive a subject identifier +#' from clinlines. +#' @param module_ids Vector of characters defining all available module IDs. +#' +#' @return Logical outcome of the test invisible. +#' @keywords internal +#' +check_receiver <- function(receiver_id, module_ids) { + if (!is.null(receiver_id) && !receiver_id %in% module_ids) { + rlang::warn( + message = c( + "Clinical Timelines: You tried to point to a receiver module + that does not exist in your module list.", + x = paste0("You have set '", receiver_id, "' as receiver_id."), + i = paste0( + "Your module list contains ", + paste(module_ids, collapse = ", "), + "." + ), + i = "Have you spelled receiver_id correctly?" + ) + ) + + return(invisible(FALSE)) + } + + return(invisible(TRUE)) +} \ No newline at end of file diff --git a/R/mod_listings.R b/R/mod_listings.R index 44a3d31..50bcdfa 100644 --- a/R/mod_listings.R +++ b/R/mod_listings.R @@ -110,14 +110,32 @@ listings_UI <- function(module_id) { # nolint #' #' @param intended_use_label `[character(1) | NULL]` Either a string indicating the intended use for export, or #' NULL. The provided label will be displayed prior to the download and will also be included in the exported file. +#' +#' @param subjid_var `[character(1)]` #' +#' Column corresponding to subject ID. Default value is 'USUBJID' +#' +#' @param receiver_id `[character(1) | NULL]` +#' +#' Character string defining the ID of the module to which to send a subject ID. The +#' module must exist in the module list. The default is NULL which disables communication. +#' +#' @param afmm_param `[list(2+) | NULL]` +#' +#' Named list of a selection of arguments from module manager. Expects +#' at least two elements: \code{utils} and \code{module_names} defining a character vector +#' whose entries have the corresponding module IDs as names. +#' #' @export listings_server <- function(module_id, dataset_list, default_vars = NULL, dataset_metadata, pagination = NULL, - intended_use_label = NULL) { + intended_use_label = NULL, + subjid_var = "USUBJID", + receiver_id = NULL, + afmm_param = NULL) { checkmate::assert( checkmate::check_character(module_id, min.chars = 1), checkmate::check_multi_class(dataset_list, c("reactive", "shinymeta_reactive")), @@ -127,6 +145,8 @@ listings_server <- function(module_id, checkmate::check_subset(names(dataset_metadata), choices = c("name", "date_range")), checkmate::check_logical(pagination, null.ok = TRUE), checkmate::check_string(intended_use_label, null.ok = TRUE), + checkmate::check_string(receiver_id, min.chars = 1, null.ok = TRUE), + checkmate::check_list(afmm_param, null.ok = TRUE), combine = "and" ) if (!is.null(default_vars)) { @@ -141,7 +161,14 @@ listings_server <- function(module_id, # Set choices as a reactive value item rvs <- shiny::reactiveValues(dataset_choices = NA, variable_choices = NA) - + + shiny::observe({ + shiny::req(afmm_param$module_names) + + # Check availability of receiver id + check_receiver(receiver_id, names(afmm_param$module_names)) + }) + # Listing selection (start) shiny::observeEvent(v_dataset_list(), { # Fill default in case bookmark or default columns do not have all the listings in the dataset @@ -340,14 +367,30 @@ listings_server <- function(module_id, action = htmlwidgets::JS(js) ) ) - ) + ), + callback = htmlwidgets::JS( + "table.on('dblclick', 'td',", + " function() {", + " var row = table.cell(this).index().row;", + " Shiny.setInputValue('dt_row_dblclicked', {row_clicked: row}, {priority: 'event'});", + " }", + ");" + ), + selection = "single" # user restricted to row selection only. ) }) + selected_subject_id <- shiny::reactive({ + shiny::req(input$dt_row_dblclicked) + dataset[[subjid_var]][input[[paste0(TBL$TABLE_ID, "__rows_selected")]]] + }) shiny::exportTestValues( selected_columns_in_dataset = r_selected_columns_in_dataset() ) + + return(list(selected_subject_id = selected_subject_id)) + }) } @@ -425,13 +468,9 @@ mod_listings <- function( intended_use_label = "Use only for internal review and monitoring during the conduct of clinical trials.", dataset_disp) { # Check validity of parameters - if (!missing(dataset_names)) { - checkmate::assert_character(dataset_names) - } - if (!missing(dataset_disp)) { - checkmate::assert_list(dataset_disp, types = "character") - } - + if (!missing(dataset_names)) checkmate::assert_character(dataset_names) + if (!missing(dataset_disp)) checkmate::assert_list(dataset_disp, types = "character") + # skip assertions/checks for module_id and default_vars since they will be checked directly in listings_server() if (!missing(dataset_disp)) { checkmate::assert( @@ -449,10 +488,8 @@ mod_listings <- function( # check if dataset_disp should be used if (missing(dataset_disp)) { use_disp <- FALSE - } else { - use_disp <- TRUE - } - + } else use_disp <- TRUE + mod <- list( ui = function(module_id) { listings_UI(module_id = module_id) diff --git a/man/check_receiver.Rd b/man/check_receiver.Rd new file mode 100644 index 0000000..b912e6e --- /dev/null +++ b/man/check_receiver.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/helpers.R +\name{check_receiver} +\alias{check_receiver} +\title{Produce a warning for non-available receiver names} +\usage{ +check_receiver(receiver_id, module_ids) +} +\arguments{ +\item{receiver_id}{Character string defining the module that should receive a subject identifier +from clinlines.} + +\item{module_ids}{Vector of characters defining all available module IDs.} +} +\value{ +Logical outcome of the test invisible. +} +\description{ +Produce a warning for non-available receiver names +} +\keyword{internal} diff --git a/man/listings_UI.Rd b/man/listings_UI.Rd index 242c86b..1cdee48 100644 --- a/man/listings_UI.Rd +++ b/man/listings_UI.Rd @@ -13,7 +13,9 @@ listings_server( default_vars = NULL, dataset_metadata, pagination = NULL, - intended_use_label = NULL + intended_use_label = NULL, + receiver_id = NULL, + afmm_param = NULL ) } \arguments{ @@ -40,6 +42,17 @@ NULL for which pagination will be activated for large datasets (nrows > 1000) au \item{intended_use_label}{\verb{[character(1) | NULL]} Either a string indicating the intended use for export, or NULL. The provided label will be displayed prior to the download and will also be included in the exported file.} + +\item{receiver_id}{\verb{[character(1) | NULL]} + +Character string defining the ID of the module to which to send a subject ID. The +module must exist in the module list. The default is NULL which disables communication.} + +\item{afmm_param}{\verb{[list(2+) | NULL]} + +Named list of a selection of arguments from module manager. Expects +at least two elements: \code{utils} and \code{module_names} defining a character vector +whose entries have the corresponding module IDs as names.} } \description{ This module displays a given dataset as listing. It allows switching between datasets if it receives From e13a17e050fa89f080d61d5bf25b7eae9121cc8b Mon Sep 17 00:00:00 2001 From: gm-ebs-ext <177268999+gm-ebs-ext@users.noreply.github.com> Date: Sat, 4 Jan 2025 00:12:15 +0000 Subject: [PATCH 02/15] add skeleton code for jumping feature --- R/mod_listings.R | 80 +++++++++++++++++++++++++++++++----------------- 1 file changed, 52 insertions(+), 28 deletions(-) diff --git a/R/mod_listings.R b/R/mod_listings.R index 50bcdfa..d59d22c 100644 --- a/R/mod_listings.R +++ b/R/mod_listings.R @@ -55,20 +55,20 @@ listings_UI <- function(module_id) { # nolint options = list(plugins = list("remove_button", "drag_drop")) ), shiny::actionButton( - ns(TBL$SELECT_ALL_COLS_BUTTON_ID), - TBL$SELECT_ALL_COLS_BUTTON_LABEL, + ns(TBL$SELECT_ALL_COLS_BUTTON_ID), + TBL$SELECT_ALL_COLS_BUTTON_LABEL, icon = shiny::icon("check-double") ), shiny::actionButton( ns(TBL$REMOVE_ALL_COLS_BUTTON_ID), - TBL$REMOVE_ALL_COLS_BUTTON_LABEL, + TBL$REMOVE_ALL_COLS_BUTTON_LABEL, icon = shiny::icon("xmark") ), shiny::actionButton( ns(TBL$RESET_COLS_DEFAULT_BUTTON_ID), - TBL$RESET_COLS_DEFAULT_BUTTON_LABEL, + TBL$RESET_COLS_DEFAULT_BUTTON_LABEL, icon = shiny::icon("rotate-left") - ), + ), circle = FALSE, icon = shiny::icon("cog"), width = TBL$DRPDBUTTON_WIDTH, @@ -85,7 +85,7 @@ listings_UI <- function(module_id) { # nolint icon = shiny::icon("filter-circle-xmark") ), shiny::br(), - DT::dataTableOutput(ns(TBL$TABLE_ID), height = "80vh"), + DT::dataTableOutput(ns(TBL$TABLE_ID), height = "80vh") ) } @@ -110,22 +110,22 @@ listings_UI <- function(module_id) { # nolint #' #' @param intended_use_label `[character(1) | NULL]` Either a string indicating the intended use for export, or #' NULL. The provided label will be displayed prior to the download and will also be included in the exported file. -#' +#' #' @param subjid_var `[character(1)]` #' #' Column corresponding to subject ID. Default value is 'USUBJID' -#' +#' #' @param receiver_id `[character(1) | NULL]` #' #' Character string defining the ID of the module to which to send a subject ID. The #' module must exist in the module list. The default is NULL which disables communication. -#' +#' #' @param afmm_param `[list(2+) | NULL]` #' #' Named list of a selection of arguments from module manager. Expects #' at least two elements: \code{utils} and \code{module_names} defining a character vector #' whose entries have the corresponding module IDs as names. -#' +#' #' @export listings_server <- function(module_id, dataset_list, @@ -161,14 +161,14 @@ listings_server <- function(module_id, # Set choices as a reactive value item rvs <- shiny::reactiveValues(dataset_choices = NA, variable_choices = NA) - + shiny::observe({ shiny::req(afmm_param$module_names) - + # Check availability of receiver id check_receiver(receiver_id, names(afmm_param$module_names)) }) - + # Listing selection (start) shiny::observeEvent(v_dataset_list(), { # Fill default in case bookmark or default columns do not have all the listings in the dataset @@ -179,6 +179,7 @@ listings_server <- function(module_id, } else { bmk_dataset } + bmk_dataset <<- NULL rvs$dataset_choices <- generate_choices(v_dataset_list()) @@ -368,29 +369,50 @@ listings_server <- function(module_id, ) ) ), - callback = htmlwidgets::JS( - "table.on('dblclick', 'td',", - " function() {", - " var row = table.cell(this).index().row;", - " Shiny.setInputValue('dt_row_dblclicked', {row_clicked: row}, {priority: 'event'});", - " }", - ");" - ), + # callback = htmlwidgets::JS( + # "table.on('dblclick', 'td',", + # " function() {", + # " var row = table.cell(this).index().row;", + # " Shiny.setInputValue('dt_row_dblclicked', {row_clicked: row}, {priority: 'event'});", + # " }", + # ");" + # ), selection = "single" # user restricted to row selection only. ) }) + # start: jumping feature -------------------------------------------------- + selected_subject_id <- shiny::reactive({ - shiny::req(input$dt_row_dblclicked) - dataset[[subjid_var]][input[[paste0(TBL$TABLE_ID, "__rows_selected")]]] + shiny::req(paste0(TBL$TABLE_ID, "_rows_selected")) + row_index <- input[[paste0(TBL$TABLE_ID, "_rows_selected")]] + listings_data() |> + dplyr::slice(row_index) |> + dplyr::pull(!!subjid_var) |> + as.character() }) + shiny::observeEvent(selected_subject_id(), { + + if (!receiver_id %in% names(afmm_param$module_names) && !is.null(receiver_id)) { + shiny::showNotification( + paste0("Can't find receiver module with ID ", receiver_id, "."), + id = NULL, + type = "message" + ) + } else if (!is.null(receiver_id)) { + afmm_param$utils$switch2mod(receiver_id) + } + + }) + + # end: jumping feature ---------------------------------------------------- + shiny::exportTestValues( selected_columns_in_dataset = r_selected_columns_in_dataset() ) - + return(list(selected_subject_id = selected_subject_id)) - }) } @@ -470,7 +492,7 @@ mod_listings <- function( # Check validity of parameters if (!missing(dataset_names)) checkmate::assert_character(dataset_names) if (!missing(dataset_disp)) checkmate::assert_list(dataset_disp, types = "character") - + # skip assertions/checks for module_id and default_vars since they will be checked directly in listings_server() if (!missing(dataset_disp)) { checkmate::assert( @@ -488,8 +510,10 @@ mod_listings <- function( # check if dataset_disp should be used if (missing(dataset_disp)) { use_disp <- FALSE - } else use_disp <- TRUE - + } else { + use_disp <- TRUE + } + mod <- list( ui = function(module_id) { listings_UI(module_id = module_id) From e5377dc0650f361c1479828a0b1eca001fef5188 Mon Sep 17 00:00:00 2001 From: gm-ebs-ext <177268999+gm-ebs-ext@users.noreply.github.com> Date: Sat, 4 Jan 2025 00:35:16 +0000 Subject: [PATCH 03/15] update mod_listings with receiver_id --- R/mod_listings.R | 31 +++++++++++++++++++------------ 1 file changed, 19 insertions(+), 12 deletions(-) diff --git a/R/mod_listings.R b/R/mod_listings.R index d59d22c..8bb3bb2 100644 --- a/R/mod_listings.R +++ b/R/mod_listings.R @@ -85,7 +85,8 @@ listings_UI <- function(module_id) { # nolint icon = shiny::icon("filter-circle-xmark") ), shiny::br(), - DT::dataTableOutput(ns(TBL$TABLE_ID), height = "80vh") + DT::dataTableOutput(ns(TBL$TABLE_ID), height = "80vh"), + shiny::verbatimTextOutput(ns("tst1")) ) } @@ -369,14 +370,14 @@ listings_server <- function(module_id, ) ) ), - # callback = htmlwidgets::JS( - # "table.on('dblclick', 'td',", - # " function() {", - # " var row = table.cell(this).index().row;", - # " Shiny.setInputValue('dt_row_dblclicked', {row_clicked: row}, {priority: 'event'});", - # " }", - # ");" - # ), + callback = htmlwidgets::JS( + "table.on('click', 'td',", + " function() {", + " var row = table.cell(this).index().row;", + " Shiny.setInputValue('dt_row_dblclicked', {row_clicked: row});", + " }", + ");" + ), selection = "single" # user restricted to row selection only. ) }) @@ -384,8 +385,9 @@ listings_server <- function(module_id, # start: jumping feature -------------------------------------------------- selected_subject_id <- shiny::reactive({ - shiny::req(paste0(TBL$TABLE_ID, "_rows_selected")) + shiny::req(input[[paste0(TBL$TABLE_ID, "_rows_selected")]]) row_index <- input[[paste0(TBL$TABLE_ID, "_rows_selected")]] + listings_data() |> dplyr::slice(row_index) |> dplyr::pull(!!subjid_var) |> @@ -488,7 +490,9 @@ mod_listings <- function( default_vars = NULL, pagination = NULL, intended_use_label = "Use only for internal review and monitoring during the conduct of clinical trials.", - dataset_disp) { + dataset_disp, + subjid_var = "USUBJID", + receiver_id = NULL) { # Check validity of parameters if (!missing(dataset_names)) checkmate::assert_character(dataset_names) if (!missing(dataset_disp)) checkmate::assert_list(dataset_disp, types = "character") @@ -533,7 +537,10 @@ mod_listings <- function( dataset_metadata = afmm$dataset_metadata, pagination = pagination, module_id = module_id, - intended_use_label = intended_use_label + intended_use_label = intended_use_label, + subjid_var = subjid_var, + receiver_id = receiver_id, + afmm_param = list(utils = afmm$utils, module_names = afmm$module_names) ) }, module_id = module_id From 1cee94a8b6dfbec9488ec9deaf51443536f11b2d Mon Sep 17 00:00:00 2001 From: gm-ebs-ext <177268999+gm-ebs-ext@users.noreply.github.com> Date: Tue, 7 Jan 2025 11:39:36 +0000 Subject: [PATCH 04/15] update version, DESCRIPTION and docs --- DESCRIPTION | 2 +- NEWS.md | 4 ++++ man/listings_UI.Rd | 5 +++++ man/mod_listings.Rd | 13 ++++++++++++- 4 files changed, 22 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index e3caaee..2a24ed7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: dv.listings Type: Package Title: Data listings module -Version: 4.0.1 +Version: 4.0.2 Authors@R: c( person("Boehringer-Ingelheim Pharma GmbH & Co.KG", role = c("cph", "fnd")), diff --git a/NEWS.md b/NEWS.md index c57e10e..809944b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,7 @@ +# dv.listings 4.0.2 + +- add jumping feature + # dv.listings 4.0.1 The module allows now to diff --git a/man/listings_UI.Rd b/man/listings_UI.Rd index 1cdee48..cef9363 100644 --- a/man/listings_UI.Rd +++ b/man/listings_UI.Rd @@ -14,6 +14,7 @@ listings_server( dataset_metadata, pagination = NULL, intended_use_label = NULL, + subjid_var = "USUBJID", receiver_id = NULL, afmm_param = NULL ) @@ -43,6 +44,10 @@ NULL for which pagination will be activated for large datasets (nrows > 1000) au \item{intended_use_label}{\verb{[character(1) | NULL]} Either a string indicating the intended use for export, or NULL. The provided label will be displayed prior to the download and will also be included in the exported file.} +\item{subjid_var}{\verb{[character(1)]} + +Column corresponding to subject ID. Default value is 'USUBJID'} + \item{receiver_id}{\verb{[character(1) | NULL]} Character string defining the ID of the module to which to send a subject ID. The diff --git a/man/mod_listings.Rd b/man/mod_listings.Rd index 1096f60..ee39d7c 100644 --- a/man/mod_listings.Rd +++ b/man/mod_listings.Rd @@ -11,7 +11,9 @@ mod_listings( pagination = NULL, intended_use_label = "Use only for internal review and monitoring during the conduct of clinical trials.", - dataset_disp + dataset_disp, + subjid_var = "USUBJID", + receiver_id = NULL ) } \arguments{ @@ -38,6 +40,15 @@ NULL. The provided label will be displayed prior to the download and will also b This is only for advanced usage. An mm_dispatch object. Can not be used together with the parameter \code{dataset_names}.} + +\item{subjid_var}{\verb{[character(1)]} + +Column corresponding to subject ID. Default value is 'USUBJID'} + +\item{receiver_id}{\verb{[character(1) | NULL]} + +Character string defining the ID of the module to which to send a subject ID. The +module must exist in the module list. The default is NULL which disables communication.} } \description{ This module will present the dataset as listing using the DT package. From db4f0fef65ba117b84de5fea8eb7cc7be17af60c Mon Sep 17 00:00:00 2001 From: gm-ebs-ext <177268999+gm-ebs-ext@users.noreply.github.com> Date: Wed, 8 Jan 2025 22:15:01 +0000 Subject: [PATCH 05/15] back up work --- .gitignore | 3 +- R/mod_listings.R | 20 ++-- vignettes/.gitignore | 2 + vignettes/Communication_jumping_feature.Rmd | 113 ++++++++++++++++++++ 4 files changed, 127 insertions(+), 11 deletions(-) create mode 100644 vignettes/.gitignore create mode 100644 vignettes/Communication_jumping_feature.Rmd diff --git a/.gitignore b/.gitignore index a9b078a..7775231 100644 --- a/.gitignore +++ b/.gitignore @@ -11,4 +11,5 @@ vignettes/*\.html vignettes/*\.R inst/validation/results/val_param.rds inst/validation/results/val_report.html -tests/testthat/app/shiny_bookmarks \ No newline at end of file +tests/testthat/app/shiny_bookmarks +inst/doc diff --git a/R/mod_listings.R b/R/mod_listings.R index 8bb3bb2..98ac325 100644 --- a/R/mod_listings.R +++ b/R/mod_listings.R @@ -370,14 +370,14 @@ listings_server <- function(module_id, ) ) ), - callback = htmlwidgets::JS( - "table.on('click', 'td',", - " function() {", - " var row = table.cell(this).index().row;", - " Shiny.setInputValue('dt_row_dblclicked', {row_clicked: row});", - " }", - ");" - ), + # callback = htmlwidgets::JS( + # "table.on('click', 'td',", + # " function() {", + # " var row = table.cell(this).index().row;", + # " Shiny.setInputValue('dt_row_dblclicked', {row_clicked: row});", + # " }", + # ");" + # ), selection = "single" # user restricted to row selection only. ) }) @@ -406,7 +406,7 @@ listings_server <- function(module_id, afmm_param$utils$switch2mod(receiver_id) } - }) + }, ignoreInit = TRUE) # end: jumping feature ---------------------------------------------------- @@ -414,7 +414,7 @@ listings_server <- function(module_id, selected_columns_in_dataset = r_selected_columns_in_dataset() ) - return(list(selected_subject_id = selected_subject_id)) + return(list(subject = selected_subject_id)) }) } diff --git a/vignettes/.gitignore b/vignettes/.gitignore new file mode 100644 index 0000000..097b241 --- /dev/null +++ b/vignettes/.gitignore @@ -0,0 +1,2 @@ +*.html +*.R diff --git a/vignettes/Communication_jumping_feature.Rmd b/vignettes/Communication_jumping_feature.Rmd new file mode 100644 index 0000000..3a91f2d --- /dev/null +++ b/vignettes/Communication_jumping_feature.Rmd @@ -0,0 +1,113 @@ +--- +title: "Communication with DaVinci modules" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{Communication with DaVinci modules} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +The dv.listings module is capable of communicating with other DaVinci modules like the Patient Profile module from {dv.papo} package. +Communication in this sense means that the listings module sends out a subject ID which can be received and further processed by other modules. At the same moment, the tab of a DaVinci app switches to the receiver module. + +The communication feature is optional and can be activated on the listings module side as follows. Note that there might be also activation needed on the counter module side (e.g. Patient Profile module side). + + +## Activate communication on Clinical Timelines module side + +As a default the `receiver_id` parameter in the `mod_listings()` call of your module list definition is set to `NULL` which means that the communication functionality is disabled. +To enable switching to another DaVinci module, set `receiver_id` to the module ID of your counterpart module. + +## Example + +Example code of a module list definition to turn the communication feature on between a listings and a Patient Profile module: + +```{r} +library(dv.listings) + +# 1. Create a data list with example data +data_list <- list( + adsl = pharmaverseadam::adsl, + adae = pharmaverseadam::adae, + adtte = pharmaverseadam::adtte_onco +) + +# 2. Preprocessing +# Convert data to appropriate types +data_list$adsl <- convert_data(data_list$adsl) +data_list$adae <- convert_data(data_list$adae) +data_list$adtte <- convert_data(data_list$adtte) + +# Assign meaningful labels to data domain names +attributes(data_list$adsl)$label <- "Subject Level" +attributes(data_list$adae)$label <- "Adverse Events" +attributes(data_list$adtte)$label <- "Time-to-Event" + +# Specify default variables +default_vars <- list( + adsl = c("STUDYID", "USUBJID", "SITEID", "ARM"), + adae = c("STUDYID", "ASTDY", "AENDT", "AESER") +) + +# 3. Module list +module_list <- list( + "Exemplary listings" = mod_listings( + module_id = "listings1", + dataset_names = c("adsl", "adae", "adtte"), + default_vars = default_vars + ), + + # Note that the focus here lies on the sender_ids parameter, not on the set up of mod_patient_profile() + "Patient Profiles" = dv.papo::mod_patient_profile( + module_id = "papo1", + subjid_var = "USUBJID", + sender_ids = "listings1" + ) +) + +# 4. Launch the app +dv.manager::run_app( + data = list("MyData" = data_list), + module_list = module_list, + filter_data = "adsl" +) + + +module_list <- list( + "Listings" = mod_clinical_timelines( + module_id = "mod1", + basic_info = set_basic_info( + subjet_level_dataset_name = "adsl", + trt_start_var = "TRTSDT", + trt_end_var = "TRTEDT", + icf_date_var = "RFICDT" + ), + mapping = list( + adsl = list("Treatment Start" = set_event(start_dt_var = "TRTSDT")) + ), + drug_admin = set_drug_admin( + dataset_name = "adex", + trt_var = "EXTRT", + start_var = "EXSTDTC", + end_var = "EXENDTC", + detail_var = "EXTRT", + label = "Drug Administration", + dose_var = "EXDOSE", + dose_unit_var = "EXDOSU" + ), + receiver_id = "mod2" + ), + # Note that the focus here lies on the sender_ids parameter, not on the set up of mod_patient_profile() + "Patient Profiles" = dv.papo::mod_patient_profile( + module_id = "mod2", + subjid_var = "USUBJID", + sender_ids = "mod1" + ) +) \ No newline at end of file From 69f254a8ce6d6ecefdce5940dddc8a03189d983c Mon Sep 17 00:00:00 2001 From: gm-ebs-ext <177268999+gm-ebs-ext@users.noreply.github.com> Date: Sat, 11 Jan 2025 22:22:46 +0000 Subject: [PATCH 06/15] update jumping feature --- R/mod_listings.R | 76 ++++++++++----------- man/listings_UI.Rd | 8 ++- vignettes/Communication_jumping_feature.Rmd | 76 ++++++++++----------- 3 files changed, 81 insertions(+), 79 deletions(-) diff --git a/R/mod_listings.R b/R/mod_listings.R index 98ac325..7935b80 100644 --- a/R/mod_listings.R +++ b/R/mod_listings.R @@ -127,6 +127,10 @@ listings_UI <- function(module_id) { # nolint #' at least two elements: \code{utils} and \code{module_names} defining a character vector #' whose entries have the corresponding module IDs as names. #' +#' @param on_sbj_click `[function()]` +#' +#' Function to invoke when a row is clicked in the subject listing table. +#' #' @export listings_server <- function(module_id, dataset_list, @@ -136,7 +140,8 @@ listings_server <- function(module_id, intended_use_label = NULL, subjid_var = "USUBJID", receiver_id = NULL, - afmm_param = NULL) { + afmm_param = NULL, + on_sbj_click = function(x){}) { checkmate::assert( checkmate::check_character(module_id, min.chars = 1), checkmate::check_multi_class(dataset_list, c("reactive", "shinymeta_reactive")), @@ -370,51 +375,34 @@ listings_server <- function(module_id, ) ) ), - # callback = htmlwidgets::JS( - # "table.on('click', 'td',", - # " function() {", - # " var row = table.cell(this).index().row;", - # " Shiny.setInputValue('dt_row_dblclicked', {row_clicked: row});", - # " }", - # ");" - # ), - selection = "single" # user restricted to row selection only. + selection = "single" ) }) - - # start: jumping feature -------------------------------------------------- - selected_subject_id <- shiny::reactive({ - shiny::req(input[[paste0(TBL$TABLE_ID, "_rows_selected")]]) - row_index <- input[[paste0(TBL$TABLE_ID, "_rows_selected")]] - - listings_data() |> - dplyr::slice(row_index) |> - dplyr::pull(!!subjid_var) |> - as.character() - }) - - shiny::observeEvent(selected_subject_id(), { - - if (!receiver_id %in% names(afmm_param$module_names) && !is.null(receiver_id)) { - shiny::showNotification( - paste0("Can't find receiver module with ID ", receiver_id, "."), - id = NULL, - type = "message" - ) - } else if (!is.null(receiver_id)) { - afmm_param$utils$switch2mod(receiver_id) - } + # start: jumping feature -------------------------------------------------- + if (!is.null(receiver_id)) { + selected_subject_id <- shiny::reactiveVal() - }, ignoreInit = TRUE) + shiny::observeEvent(input[[paste0(TBL$TABLE_ID, "_rows_selected")]], { + row_index <- input[[paste0(TBL$TABLE_ID, "_rows_selected")]] + subject <- listings_data() |> + dplyr::slice(row_index) |> + dplyr::pull(!!subjid_var) |> + as.character() + selected_subject_id(subject) + print(selected_subject_id()) + on_sbj_click() + }) + } + + return(selected_subject_id) # end: jumping feature ---------------------------------------------------- - + shiny::exportTestValues( selected_columns_in_dataset = r_selected_columns_in_dataset() ) - return(list(subject = selected_subject_id)) }) } @@ -514,9 +502,8 @@ mod_listings <- function( # check if dataset_disp should be used if (missing(dataset_disp)) { use_disp <- FALSE - } else { - use_disp <- TRUE - } + } else use_disp <- TRUE + mod <- list( ui = function(module_id) { @@ -530,6 +517,14 @@ mod_listings <- function( afmm$filtered_dataset()[dataset_names] }) } + + if (is.null(receiver_id)) { + on_sbj_click_fun <- function() NULL + } else { + on_sbj_click_fun <- function() { + afmm[["utils"]][["switch2mod"]](receiver_id) + } + } listings_server( dataset_list = dataset_list, @@ -540,7 +535,8 @@ mod_listings <- function( intended_use_label = intended_use_label, subjid_var = subjid_var, receiver_id = receiver_id, - afmm_param = list(utils = afmm$utils, module_names = afmm$module_names) + afmm_param = list(utils = afmm$utils, module_names = afmm$module_names), + on_sbj_click = on_sbj_click_fun ) }, module_id = module_id diff --git a/man/listings_UI.Rd b/man/listings_UI.Rd index cef9363..511f132 100644 --- a/man/listings_UI.Rd +++ b/man/listings_UI.Rd @@ -16,7 +16,9 @@ listings_server( intended_use_label = NULL, subjid_var = "USUBJID", receiver_id = NULL, - afmm_param = NULL + afmm_param = NULL, + on_sbj_click = function(x) { + } ) } \arguments{ @@ -58,6 +60,10 @@ module must exist in the module list. The default is NULL which disables communi Named list of a selection of arguments from module manager. Expects at least two elements: \code{utils} and \code{module_names} defining a character vector whose entries have the corresponding module IDs as names.} + +\item{on_sbj_click}{\verb{[function()]} + +Function to invoke when a row is clicked in the subject listing table.} } \description{ This module displays a given dataset as listing. It allows switching between datasets if it receives diff --git a/vignettes/Communication_jumping_feature.Rmd b/vignettes/Communication_jumping_feature.Rmd index 3a91f2d..ba2648d 100644 --- a/vignettes/Communication_jumping_feature.Rmd +++ b/vignettes/Communication_jumping_feature.Rmd @@ -73,41 +73,41 @@ module_list <- list( ) # 4. Launch the app -dv.manager::run_app( - data = list("MyData" = data_list), - module_list = module_list, - filter_data = "adsl" -) - - -module_list <- list( - "Listings" = mod_clinical_timelines( - module_id = "mod1", - basic_info = set_basic_info( - subjet_level_dataset_name = "adsl", - trt_start_var = "TRTSDT", - trt_end_var = "TRTEDT", - icf_date_var = "RFICDT" - ), - mapping = list( - adsl = list("Treatment Start" = set_event(start_dt_var = "TRTSDT")) - ), - drug_admin = set_drug_admin( - dataset_name = "adex", - trt_var = "EXTRT", - start_var = "EXSTDTC", - end_var = "EXENDTC", - detail_var = "EXTRT", - label = "Drug Administration", - dose_var = "EXDOSE", - dose_unit_var = "EXDOSU" - ), - receiver_id = "mod2" - ), - # Note that the focus here lies on the sender_ids parameter, not on the set up of mod_patient_profile() - "Patient Profiles" = dv.papo::mod_patient_profile( - module_id = "mod2", - subjid_var = "USUBJID", - sender_ids = "mod1" - ) -) \ No newline at end of file +# dv.manager::run_app( +# data = list("MyData" = data_list), +# module_list = module_list, +# filter_data = "adsl" +# ) +# +# +# module_list <- list( +# "Listings" = mod_clinical_timelines( +# module_id = "mod1", +# basic_info = set_basic_info( +# subjet_level_dataset_name = "adsl", +# trt_start_var = "TRTSDT", +# trt_end_var = "TRTEDT", +# icf_date_var = "RFICDT" +# ), +# mapping = list( +# adsl = list("Treatment Start" = set_event(start_dt_var = "TRTSDT")) +# ), +# drug_admin = set_drug_admin( +# dataset_name = "adex", +# trt_var = "EXTRT", +# start_var = "EXSTDTC", +# end_var = "EXENDTC", +# detail_var = "EXTRT", +# label = "Drug Administration", +# dose_var = "EXDOSE", +# dose_unit_var = "EXDOSU" +# ), +# receiver_id = "mod2" +# ), +# # Note that the focus here lies on the sender_ids parameter, not on the set up of mod_patient_profile() +# "Patient Profiles" = dv.papo::mod_patient_profile( +# module_id = "mod2", +# subjid_var = "USUBJID", +# sender_ids = "mod1" +# ) +# ) \ No newline at end of file From 6cd7240b0378812e1b9f320da7c269100957b436 Mon Sep 17 00:00:00 2001 From: gm-ebs-ext <177268999+gm-ebs-ext@users.noreply.github.com> Date: Sat, 11 Jan 2025 23:00:25 +0000 Subject: [PATCH 07/15] fix and add working example in vignette --- R/mod_listings.R | 33 +++++---- vignettes/Communication_jumping_feature.Rmd | 75 +++++++-------------- 2 files changed, 40 insertions(+), 68 deletions(-) diff --git a/R/mod_listings.R b/R/mod_listings.R index 7935b80..786aa0f 100644 --- a/R/mod_listings.R +++ b/R/mod_listings.R @@ -127,10 +127,6 @@ listings_UI <- function(module_id) { # nolint #' at least two elements: \code{utils} and \code{module_names} defining a character vector #' whose entries have the corresponding module IDs as names. #' -#' @param on_sbj_click `[function()]` -#' -#' Function to invoke when a row is clicked in the subject listing table. -#' #' @export listings_server <- function(module_id, dataset_list, @@ -140,8 +136,7 @@ listings_server <- function(module_id, intended_use_label = NULL, subjid_var = "USUBJID", receiver_id = NULL, - afmm_param = NULL, - on_sbj_click = function(x){}) { + afmm_param = NULL) { checkmate::assert( checkmate::check_character(module_id, min.chars = 1), checkmate::check_multi_class(dataset_list, c("reactive", "shinymeta_reactive")), @@ -380,6 +375,8 @@ listings_server <- function(module_id, }) # start: jumping feature -------------------------------------------------- + subject <- NULL + if (!is.null(receiver_id)) { selected_subject_id <- shiny::reactiveVal() @@ -391,11 +388,12 @@ listings_server <- function(module_id, as.character() selected_subject_id(subject) print(selected_subject_id()) - on_sbj_click() + afmm_param$utils$switch2mod(receiver_id) }) + subject <- list(subj_id = shiny::reactive(selected_subject_id())) # to papo } - - return(selected_subject_id) + + return(subject) # end: jumping feature ---------------------------------------------------- @@ -518,13 +516,13 @@ mod_listings <- function( }) } - if (is.null(receiver_id)) { - on_sbj_click_fun <- function() NULL - } else { - on_sbj_click_fun <- function() { - afmm[["utils"]][["switch2mod"]](receiver_id) - } - } + # if (is.null(receiver_id)) { + # on_sbj_click_fun <- function() NULL + # } else { + # on_sbj_click_fun <- function() { + # afmm[["utils"]][["switch2mod"]](receiver_id) + # } + # } listings_server( dataset_list = dataset_list, @@ -535,8 +533,7 @@ mod_listings <- function( intended_use_label = intended_use_label, subjid_var = subjid_var, receiver_id = receiver_id, - afmm_param = list(utils = afmm$utils, module_names = afmm$module_names), - on_sbj_click = on_sbj_click_fun + afmm_param = list(utils = afmm$utils, module_names = afmm$module_names) ) }, module_id = module_id diff --git a/vignettes/Communication_jumping_feature.Rmd b/vignettes/Communication_jumping_feature.Rmd index ba2648d..7af4cf8 100644 --- a/vignettes/Communication_jumping_feature.Rmd +++ b/vignettes/Communication_jumping_feature.Rmd @@ -33,14 +33,15 @@ Example code of a module list definition to turn the communication feature on be library(dv.listings) # 1. Create a data list with example data -data_list <- list( +dataset_list <- list( + "demo" = dv.papo:::prep_safety_data(5), + "demo2" = dv.papo:::prep_safety_data(10), adsl = pharmaverseadam::adsl, adae = pharmaverseadam::adae, - adtte = pharmaverseadam::adtte_onco + adtte = pharmaverseadam::adtte_onco, + cm = pharmaverseadam::adcm ) - -# 2. Preprocessing -# Convert data to appropriate types +#Convert data to appropriate types data_list$adsl <- convert_data(data_list$adsl) data_list$adae <- convert_data(data_list$adae) data_list$adtte <- convert_data(data_list$adtte) @@ -55,59 +56,33 @@ default_vars <- list( adsl = c("STUDYID", "USUBJID", "SITEID", "ARM"), adae = c("STUDYID", "ASTDY", "AENDT", "AESER") ) - -# 3. Module list module_list <- list( "Exemplary listings" = mod_listings( module_id = "listings1", dataset_names = c("adsl", "adae", "adtte"), - default_vars = default_vars + default_vars = default_vars, + receiver_id = "papo1" ), - - # Note that the focus here lies on the sender_ids parameter, not on the set up of mod_patient_profile() - "Patient Profiles" = dv.papo::mod_patient_profile( + "Patient Profile" = dv.papo::mod_patient_profile( module_id = "papo1", + subject_level_dataset_name = "adsl", subjid_var = "USUBJID", + summary = list( + vars = c("SUBJID", "SITEID", "ARM", "TRTSDT", "TRTEDT", "AGE", "RACE", "SEX"), + column_count = 3L + ), + listings = list( + "Adverse Events" = list( + dataset = "adae", + default_vars = c("ASTDT", "ASTDY", "AENDT", "AENDY", "AEDECOD", "AESEV") + ) + ), sender_ids = "listings1" ) ) -# 4. Launch the app -# dv.manager::run_app( -# data = list("MyData" = data_list), -# module_list = module_list, -# filter_data = "adsl" -# ) -# -# -# module_list <- list( -# "Listings" = mod_clinical_timelines( -# module_id = "mod1", -# basic_info = set_basic_info( -# subjet_level_dataset_name = "adsl", -# trt_start_var = "TRTSDT", -# trt_end_var = "TRTEDT", -# icf_date_var = "RFICDT" -# ), -# mapping = list( -# adsl = list("Treatment Start" = set_event(start_dt_var = "TRTSDT")) -# ), -# drug_admin = set_drug_admin( -# dataset_name = "adex", -# trt_var = "EXTRT", -# start_var = "EXSTDTC", -# end_var = "EXENDTC", -# detail_var = "EXTRT", -# label = "Drug Administration", -# dose_var = "EXDOSE", -# dose_unit_var = "EXDOSU" -# ), -# receiver_id = "mod2" -# ), -# # Note that the focus here lies on the sender_ids parameter, not on the set up of mod_patient_profile() -# "Patient Profiles" = dv.papo::mod_patient_profile( -# module_id = "mod2", -# subjid_var = "USUBJID", -# sender_ids = "mod1" -# ) -# ) \ No newline at end of file +dv.manager::run_app( + data = list("MyData" = data_list), + module_list = module_list, + filter_data = "adsl" +) From d39cf5128fe7d694a5082af29c8bf70012715870 Mon Sep 17 00:00:00 2001 From: gm-ebs-ext <177268999+gm-ebs-ext@users.noreply.github.com> Date: Mon, 13 Jan 2025 23:22:06 +0000 Subject: [PATCH 08/15] fix example data list --- R/mod_listings.R | 1 + README.md | 3 +++ vignettes/Communication_jumping_feature.Rmd | 13 +++++++------ 3 files changed, 11 insertions(+), 6 deletions(-) diff --git a/R/mod_listings.R b/R/mod_listings.R index 786aa0f..2436ebc 100644 --- a/R/mod_listings.R +++ b/R/mod_listings.R @@ -375,6 +375,7 @@ listings_server <- function(module_id, }) # start: jumping feature -------------------------------------------------- + subject <- NULL if (!is.null(receiver_id)) { diff --git a/README.md b/README.md index c620ba5..73fd63e 100644 --- a/README.md +++ b/README.md @@ -112,3 +112,6 @@ To download the currently active listing, it will be saved exactly as it appears For users who wish to download all listings, the module allows saving in .xlsx format exclusively. This process disregards any local filters, and each listing is saved in a separate worksheet within the file. Please be aware that the PDF download feature is implemented using an RMarkdown file that is rendered into a PDF through LaTeX. As such, it is important to note that a LaTeX installation, along with the necessary packages, is required to use this feature. + +## Jumping Feature + diff --git a/vignettes/Communication_jumping_feature.Rmd b/vignettes/Communication_jumping_feature.Rmd index 7af4cf8..779410d 100644 --- a/vignettes/Communication_jumping_feature.Rmd +++ b/vignettes/Communication_jumping_feature.Rmd @@ -33,14 +33,12 @@ Example code of a module list definition to turn the communication feature on be library(dv.listings) # 1. Create a data list with example data -dataset_list <- list( - "demo" = dv.papo:::prep_safety_data(5), - "demo2" = dv.papo:::prep_safety_data(10), +data_list <- list( adsl = pharmaverseadam::adsl, adae = pharmaverseadam::adae, - adtte = pharmaverseadam::adtte_onco, - cm = pharmaverseadam::adcm + adtte = pharmaverseadam::adtte_onco ) + #Convert data to appropriate types data_list$adsl <- convert_data(data_list$adsl) data_list$adae <- convert_data(data_list$adae) @@ -56,8 +54,10 @@ default_vars <- list( adsl = c("STUDYID", "USUBJID", "SITEID", "ARM"), adae = c("STUDYID", "ASTDY", "AENDT", "AESER") ) + +# 2. Create list of modules - must include listings module and dv.papo module. module_list <- list( - "Exemplary listings" = mod_listings( + "Exemplary listings" = dv.listings::mod_listings( module_id = "listings1", dataset_names = c("adsl", "adae", "adtte"), default_vars = default_vars, @@ -86,3 +86,4 @@ dv.manager::run_app( module_list = module_list, filter_data = "adsl" ) +``` \ No newline at end of file From c22bd5a36d0bbc7b2c37f2bc5981b9ea833c081c Mon Sep 17 00:00:00 2001 From: gm-ebs-ext <177268999+gm-ebs-ext@users.noreply.github.com> Date: Thu, 16 Jan 2025 00:18:40 +0000 Subject: [PATCH 09/15] fix failing bookmarking unit test --- R/mod_listings.R | 14 ++------------ 1 file changed, 2 insertions(+), 12 deletions(-) diff --git a/R/mod_listings.R b/R/mod_listings.R index 2436ebc..4a14f28 100644 --- a/R/mod_listings.R +++ b/R/mod_listings.R @@ -376,9 +376,8 @@ listings_server <- function(module_id, # start: jumping feature -------------------------------------------------- - subject <- NULL - if (!is.null(receiver_id)) { + subject <- NULL selected_subject_id <- shiny::reactiveVal() shiny::observeEvent(input[[paste0(TBL$TABLE_ID, "_rows_selected")]], { @@ -392,9 +391,8 @@ listings_server <- function(module_id, afmm_param$utils$switch2mod(receiver_id) }) subject <- list(subj_id = shiny::reactive(selected_subject_id())) # to papo + return(subject) } - - return(subject) # end: jumping feature ---------------------------------------------------- @@ -516,14 +514,6 @@ mod_listings <- function( afmm$filtered_dataset()[dataset_names] }) } - - # if (is.null(receiver_id)) { - # on_sbj_click_fun <- function() NULL - # } else { - # on_sbj_click_fun <- function() { - # afmm[["utils"]][["switch2mod"]](receiver_id) - # } - # } listings_server( dataset_list = dataset_list, From 21178e1e7cab952b02a81c7ec6f320fef39fc39a Mon Sep 17 00:00:00 2001 From: gm-ebs-ext <177268999+gm-ebs-ext@users.noreply.github.com> Date: Mon, 20 Jan 2025 13:51:03 +0000 Subject: [PATCH 10/15] simplify subject selection code --- R/mod_listings.R | 13 +++++-------- 1 file changed, 5 insertions(+), 8 deletions(-) diff --git a/R/mod_listings.R b/R/mod_listings.R index 4a14f28..64c4567 100644 --- a/R/mod_listings.R +++ b/R/mod_listings.R @@ -375,22 +375,19 @@ listings_server <- function(module_id, }) # start: jumping feature -------------------------------------------------- - if (!is.null(receiver_id)) { - subject <- NULL selected_subject_id <- shiny::reactiveVal() shiny::observeEvent(input[[paste0(TBL$TABLE_ID, "_rows_selected")]], { row_index <- input[[paste0(TBL$TABLE_ID, "_rows_selected")]] - subject <- listings_data() |> - dplyr::slice(row_index) |> - dplyr::pull(!!subjid_var) |> - as.character() + subject <- listings_data()[[subjid_var]][row_index] |> as.character() + selected_subject_id(subject) - print(selected_subject_id()) afmm_param$utils$switch2mod(receiver_id) }) - subject <- list(subj_id = shiny::reactive(selected_subject_id())) # to papo + + # N.B papo requires a list containing an element named 'subj_id', hence: + subject <- list(subj_id = selected_subject_id) return(subject) } From aca095ff7d04cd7387554d359713b425cbc93874 Mon Sep 17 00:00:00 2001 From: gm-ebs-ext <177268999+gm-ebs-ext@users.noreply.github.com> Date: Mon, 20 Jan 2025 22:14:48 +0000 Subject: [PATCH 11/15] add test for jumping feature --- inst/validation/specs.R | 3 +- tests/testthat/apps/jumping_feature_app/app.R | 61 +++++++++++++++++++ tests/testthat/test-mod_listing.R | 39 ++++++++++++ 3 files changed, 102 insertions(+), 1 deletion(-) create mode 100644 tests/testthat/apps/jumping_feature_app/app.R diff --git a/inst/validation/specs.R b/inst/validation/specs.R index c12c460..ed27579 100644 --- a/inst/validation/specs.R +++ b/inst/validation/specs.R @@ -16,7 +16,8 @@ listing <- specs_list( "select_all_columns" = "dv.listings includes functionality to select all the columns.", "unselect_all_columns" = "dv.listings includes functionality to unselect all the columns.", "reset_columns" = "dv.listings includes includes functionality to reset to the default columns.", - "reset_filters" = "dv.listings includes functionality to reset all filters." + "reset_filters" = "dv.listings includes functionality to reset all filters.", + "jumping_feature" = "dv.listings includes jumping feature." ) export <- specs_list( "export" = "dv.listings includes a button to export the listing(s). A click to the button envokes a pop-up to appear that allows the user to decide whether the download should only contain the displayed listing or all available listings, provide a file name (defaulted to the dataset name), and select from available file types.", diff --git a/tests/testthat/apps/jumping_feature_app/app.R b/tests/testthat/apps/jumping_feature_app/app.R new file mode 100644 index 0000000..4c663bf --- /dev/null +++ b/tests/testthat/apps/jumping_feature_app/app.R @@ -0,0 +1,61 @@ +use_load_all <- isTRUE(as.logical(Sys.getenv("TEST_LOCAL"))) | isTRUE(as.logical(Sys.getenv("TEST_PUSH"))) +if (use_load_all) { + devtools::load_all("../../../../", quiet = TRUE) +} else { + library(dv.listings) +} + +# 1. Create a data list with example data +data_list <- list( + adsl = pharmaverseadam::adsl, + adae = pharmaverseadam::adae, + adtte = pharmaverseadam::adtte_onco +) + +#Convert data to appropriate types +data_list$adsl <- dv.listings::convert_data(data_list$adsl) +data_list$adae <- dv.listings::convert_data(data_list$adae) +data_list$adtte <- dv.listings::convert_data(data_list$adtte) + +# Assign meaningful labels to data domain names +attributes(data_list$adsl)$label <- "Subject Level" +attributes(data_list$adae)$label <- "Adverse Events" +attributes(data_list$adtte)$label <- "Time-to-Event" + +# Specify default variables +default_vars <- list( + adsl = c("STUDYID", "USUBJID", "SITEID", "ARM"), + adae = c("STUDYID", "ASTDY", "AENDT", "AESER") +) + +# 2. Create list of modules - must include listings module and dv.papo module. +module_list <- list( + "Exemplary listings" = dv.listings::mod_listings( + module_id = "listings1", + dataset_names = c("adsl", "adae", "adtte"), + default_vars = default_vars, + receiver_id = "papo1" + ), + "Patient Profile" = dv.papo::mod_patient_profile( + module_id = "papo1", + subject_level_dataset_name = "adsl", + subjid_var = "USUBJID", + summary = list( + vars = c("SUBJID", "SITEID", "ARM", "TRTSDT", "TRTEDT", "AGE", "RACE", "SEX"), + column_count = 3L + ), + listings = list( + "Adverse Events" = list( + dataset = "adae", + default_vars = c("ASTDT", "ASTDY", "AENDT", "AENDY", "AEDECOD", "AESEV") + ) + ), + sender_ids = "listings1" + ) +) + +dv.manager::run_app( + data = list("MyData" = data_list), + module_list = module_list, + filter_data = "adsl" +) \ No newline at end of file diff --git a/tests/testthat/test-mod_listing.R b/tests/testthat/test-mod_listing.R index 00e0dcb..d8a8b27 100644 --- a/tests/testthat/test-mod_listing.R +++ b/tests/testthat/test-mod_listing.R @@ -641,3 +641,42 @@ test_that("resetting filters works correctly" %>% testthat::expect_equal(actual, expected) }) + +test_that("jumping feature works correctly" %>% + vdoc[["add_spec"]](specs$jumping_feature), { + + app <- shinytest2::AppDriver$new( + app_dir = "./apps/jumping_feature_app", name = "test_jumping_feature" + ) + + # SELECT A ROW + # row 2 subject is "01-701-1023" + app$set_inputs( + `listings1-listing_rows_selected` = 2, allow_no_input_binding_ = TRUE + ) + app$set_inputs( + `listings1-listing_row_last_clicked` = 2, + allow_no_input_binding_ = TRUE, priority_ = "event" + ) + app$wait_for_idle() + + # CHECK PAPO SELECTED CORRECT SUBJECT + actual <- app$get_value(input = "papo1-patient_selector") + testthat::expect_equal(actual, "01-701-1023") + + # SELECT A ROW + # row 11 subject is "01-701-1118" + app$set_inputs( + `listings1-listing_rows_selected` = 11, allow_no_input_binding_ = TRUE + ) + app$set_inputs( + `listings1-listing_row_last_clicked` = 11, + allow_no_input_binding_ = TRUE, priority_ = "event" + ) + app$wait_for_idle() + + # CHECK PAPO SELECTED CORRECT SUBJECT + actual <- app$get_value(input = "papo1-patient_selector") + testthat::expect_equal(actual, "01-701-1118") + +}) \ No newline at end of file From da9e017cb43f649c776ab924b5f028f32ba2eb2a Mon Sep 17 00:00:00 2001 From: gm-ebs-ext <177268999+gm-ebs-ext@users.noreply.github.com> Date: Mon, 20 Jan 2025 22:42:54 +0000 Subject: [PATCH 12/15] update README and vignette --- R/helpers.R | 31 --------------------- README.md | 1 + vignettes/Communication_jumping_feature.Rmd | 2 +- 3 files changed, 2 insertions(+), 32 deletions(-) diff --git a/R/helpers.R b/R/helpers.R index ada5e12..d9ebbb1 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -247,34 +247,3 @@ set_up_datatable <- function(dataset, selected_cols, pagination) { ) ) } - -#' Produce a warning for non-available receiver names -#' -#' @param receiver_id Character string defining the module that should receive a subject identifier -#' from clinlines. -#' @param module_ids Vector of characters defining all available module IDs. -#' -#' @return Logical outcome of the test invisible. -#' @keywords internal -#' -check_receiver <- function(receiver_id, module_ids) { - if (!is.null(receiver_id) && !receiver_id %in% module_ids) { - rlang::warn( - message = c( - "Clinical Timelines: You tried to point to a receiver module - that does not exist in your module list.", - x = paste0("You have set '", receiver_id, "' as receiver_id."), - i = paste0( - "Your module list contains ", - paste(module_ids, collapse = ", "), - "." - ), - i = "Have you spelled receiver_id correctly?" - ) - ) - - return(invisible(FALSE)) - } - - return(invisible(TRUE)) -} \ No newline at end of file diff --git a/README.md b/README.md index 73fd63e..f0b96bb 100644 --- a/README.md +++ b/README.md @@ -115,3 +115,4 @@ Please be aware that the PDF download feature is implemented using an RMarkdown ## Jumping Feature +Users can select a row from listings table to jump to a patient profile of the subject. The row turns blue once selected and remains grey on hover. To see a working example, please consult "Communication_jumping_feature" vignette. diff --git a/vignettes/Communication_jumping_feature.Rmd b/vignettes/Communication_jumping_feature.Rmd index 779410d..3c27240 100644 --- a/vignettes/Communication_jumping_feature.Rmd +++ b/vignettes/Communication_jumping_feature.Rmd @@ -20,7 +20,7 @@ Communication in this sense means that the listings module sends out a subject I The communication feature is optional and can be activated on the listings module side as follows. Note that there might be also activation needed on the counter module side (e.g. Patient Profile module side). -## Activate communication on Clinical Timelines module side +## Activate communication within listings module As a default the `receiver_id` parameter in the `mod_listings()` call of your module list definition is set to `NULL` which means that the communication functionality is disabled. To enable switching to another DaVinci module, set `receiver_id` to the module ID of your counterpart module. From 9ddfacf6ec7efb39c5fb902cafd64e7c89d03999 Mon Sep 17 00:00:00 2001 From: gm-ebs-ext <177268999+gm-ebs-ext@users.noreply.github.com> Date: Mon, 20 Jan 2025 22:53:32 +0000 Subject: [PATCH 13/15] update docs --- .Rbuildignore | 4 +++- .gitignore | 2 ++ DESCRIPTION | 1 + man/check_receiver.Rd | 21 --------------------- man/listings_UI.Rd | 8 +------- 5 files changed, 7 insertions(+), 29 deletions(-) delete mode 100644 man/check_receiver.Rd diff --git a/.Rbuildignore b/.Rbuildignore index adf83e7..0a8cb25 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -5,4 +5,6 @@ ^docs$ ^README\.html$ ^LICENSE$ -^\.github \ No newline at end of file +^\.github +^doc$ +^Meta$ diff --git a/.gitignore b/.gitignore index 7775231..a6c71ca 100644 --- a/.gitignore +++ b/.gitignore @@ -13,3 +13,5 @@ inst/validation/results/val_param.rds inst/validation/results/val_report.html tests/testthat/app/shiny_bookmarks inst/doc +/doc/ +/Meta/ diff --git a/DESCRIPTION b/DESCRIPTION index 2a24ed7..2dc17a7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -31,6 +31,7 @@ Imports: dplyr (>= 1.0.5), DT (>= 0.18), dv.manager (>= 2.0.0-17), + dv.papo (>= 2.0.1), htmlwidgets (>= 1.6.2), magrittr (>= 2.0.3), openxlsx (>= 4.2.5.2), diff --git a/man/check_receiver.Rd b/man/check_receiver.Rd deleted file mode 100644 index b912e6e..0000000 --- a/man/check_receiver.Rd +++ /dev/null @@ -1,21 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/helpers.R -\name{check_receiver} -\alias{check_receiver} -\title{Produce a warning for non-available receiver names} -\usage{ -check_receiver(receiver_id, module_ids) -} -\arguments{ -\item{receiver_id}{Character string defining the module that should receive a subject identifier -from clinlines.} - -\item{module_ids}{Vector of characters defining all available module IDs.} -} -\value{ -Logical outcome of the test invisible. -} -\description{ -Produce a warning for non-available receiver names -} -\keyword{internal} diff --git a/man/listings_UI.Rd b/man/listings_UI.Rd index 511f132..cef9363 100644 --- a/man/listings_UI.Rd +++ b/man/listings_UI.Rd @@ -16,9 +16,7 @@ listings_server( intended_use_label = NULL, subjid_var = "USUBJID", receiver_id = NULL, - afmm_param = NULL, - on_sbj_click = function(x) { - } + afmm_param = NULL ) } \arguments{ @@ -60,10 +58,6 @@ module must exist in the module list. The default is NULL which disables communi Named list of a selection of arguments from module manager. Expects at least two elements: \code{utils} and \code{module_names} defining a character vector whose entries have the corresponding module IDs as names.} - -\item{on_sbj_click}{\verb{[function()]} - -Function to invoke when a row is clicked in the subject listing table.} } \description{ This module displays a given dataset as listing. It allows switching between datasets if it receives From 28d5e424dd737198443cecac514538fc53504563 Mon Sep 17 00:00:00 2001 From: gm-ebs-ext <177268999+gm-ebs-ext@users.noreply.github.com> Date: Mon, 20 Jan 2025 22:55:31 +0000 Subject: [PATCH 14/15] add back check_receiver function --- R/helpers.R | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/R/helpers.R b/R/helpers.R index d9ebbb1..ada5e12 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -247,3 +247,34 @@ set_up_datatable <- function(dataset, selected_cols, pagination) { ) ) } + +#' Produce a warning for non-available receiver names +#' +#' @param receiver_id Character string defining the module that should receive a subject identifier +#' from clinlines. +#' @param module_ids Vector of characters defining all available module IDs. +#' +#' @return Logical outcome of the test invisible. +#' @keywords internal +#' +check_receiver <- function(receiver_id, module_ids) { + if (!is.null(receiver_id) && !receiver_id %in% module_ids) { + rlang::warn( + message = c( + "Clinical Timelines: You tried to point to a receiver module + that does not exist in your module list.", + x = paste0("You have set '", receiver_id, "' as receiver_id."), + i = paste0( + "Your module list contains ", + paste(module_ids, collapse = ", "), + "." + ), + i = "Have you spelled receiver_id correctly?" + ) + ) + + return(invisible(FALSE)) + } + + return(invisible(TRUE)) +} \ No newline at end of file From 17d78c74f0073cfd4e29a58aa2f8098b26581485 Mon Sep 17 00:00:00 2001 From: gm-ebs-ext <177268999+gm-ebs-ext@users.noreply.github.com> Date: Mon, 20 Jan 2025 22:57:54 +0000 Subject: [PATCH 15/15] fix linting errors --- R/helpers.R | 2 +- R/mod_listings.R | 4 +++- tests/testthat/apps/jumping_feature_app/app.R | 2 +- tests/testthat/test-mod_listing.R | 2 +- vignettes/Communication_jumping_feature.Rmd | 2 +- 5 files changed, 7 insertions(+), 5 deletions(-) diff --git a/R/helpers.R b/R/helpers.R index ada5e12..1d05e72 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -277,4 +277,4 @@ check_receiver <- function(receiver_id, module_ids) { } return(invisible(TRUE)) -} \ No newline at end of file +} diff --git a/R/mod_listings.R b/R/mod_listings.R index 64c4567..b863ec0 100644 --- a/R/mod_listings.R +++ b/R/mod_listings.R @@ -496,7 +496,9 @@ mod_listings <- function( # check if dataset_disp should be used if (missing(dataset_disp)) { use_disp <- FALSE - } else use_disp <- TRUE + } else { + use_disp <- TRUE + } mod <- list( diff --git a/tests/testthat/apps/jumping_feature_app/app.R b/tests/testthat/apps/jumping_feature_app/app.R index 4c663bf..9af85da 100644 --- a/tests/testthat/apps/jumping_feature_app/app.R +++ b/tests/testthat/apps/jumping_feature_app/app.R @@ -58,4 +58,4 @@ dv.manager::run_app( data = list("MyData" = data_list), module_list = module_list, filter_data = "adsl" -) \ No newline at end of file +) diff --git a/tests/testthat/test-mod_listing.R b/tests/testthat/test-mod_listing.R index d8a8b27..2bc6abf 100644 --- a/tests/testthat/test-mod_listing.R +++ b/tests/testthat/test-mod_listing.R @@ -679,4 +679,4 @@ test_that("jumping feature works correctly" %>% actual <- app$get_value(input = "papo1-patient_selector") testthat::expect_equal(actual, "01-701-1118") -}) \ No newline at end of file +}) diff --git a/vignettes/Communication_jumping_feature.Rmd b/vignettes/Communication_jumping_feature.Rmd index 3c27240..94da085 100644 --- a/vignettes/Communication_jumping_feature.Rmd +++ b/vignettes/Communication_jumping_feature.Rmd @@ -86,4 +86,4 @@ dv.manager::run_app( module_list = module_list, filter_data = "adsl" ) -``` \ No newline at end of file +```