From 1fb71c0739f9460e8449b503ef84610f155ea69e Mon Sep 17 00:00:00 2001 From: Lovemore Gakava Date: Fri, 4 Oct 2024 18:20:41 +0000 Subject: [PATCH 1/8] fix: - nepexplorerMod: Update sidebar to only have default labs for profile - patient_profile_mod:remove default_labs processing and use the declared ones from nepexplorerMod - update documentation --- .Rbuildignore | 3 +++ .gitignore | 5 ++++- R/nepexplorerMod.R | 29 ++++++++++++++++++++++++----- R/patient_profile_mod.R | 37 +++++++++++++++++++------------------ man/patientProfileServer.Rd | 2 +- 5 files changed, 51 insertions(+), 25 deletions(-) diff --git a/.Rbuildignore b/.Rbuildignore index f3c8930..b821361 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -5,3 +5,6 @@ ^outline\.md$ ^\.github$ ^\.lintr$ +^nepExplorer\.Rcheck$ +^nepExplorer.*\.tar\.gz$ +^nepExplorer.*\.tgz$ diff --git a/.gitignore b/.gitignore index 7145ffb..9a52e8b 100644 --- a/.gitignore +++ b/.gitignore @@ -107,4 +107,7 @@ dist # Ignoring R History and R Data Root: .Rhistory -.RData \ No newline at end of file +.RData +nepExplorer.Rcheck/ +nepExplorer*.tar.gz +nepExplorer*.tgz diff --git a/R/nepexplorerMod.R b/R/nepexplorerMod.R index d41dfec..bda3173 100644 --- a/R/nepexplorerMod.R +++ b/R/nepexplorerMod.R @@ -97,16 +97,28 @@ nepexplorer_server <- function(input, output, session, params) { } }) + # Populate sidebar control with measures and select all by default # Populate sidebar control with measures and select all by default observe({ + + default_labs <- c(param()$settings$labs$measure_value$BICARB, + param()$settings$labs$measure_value$BUN, + param()$settings$labs$measure_value$CA, + param()$settings$labs$measure_value$CL, + param()$settings$labs$measure_value$PHOS, + param()$settings$labs$measure_value$K, + param()$settings$labs$measure_value$SODIUM) + + measure_col <- param()$settings$labs$measure_col - measures <- unique(param()$data$labs[[measure_col]]) + measures <- intersect(unique(param()$data$labs[[measure_col]]), default_labs) + updateSelectizeInput(session, "measures", choices = measures, selected = measures ) - + }) animate <- reactive(input$animate) @@ -133,10 +145,17 @@ nepexplorer_server <- function(input, output, session, params) { }) #Patient Profile (demo tables + lab line charts) observeEvent(selected_subject(), { - - if (length(selected_subject()) == 1) { # avoid triggering patient profiles if there isn't a subject + if (length(selected_subject()) == 1) { patientProfileServer("patprofile", df = param()$data$labs, - settings = param()$settings$labs, subj_id = selected_subject()) + settings = param()$settings$labs, subj_id = selected_subject(), + patient_measures = input$measures) + + # Create a nested observeEvent for input$measure + observeEvent(input$measures, { + patientProfileServer("patprofile", df = param()$data$labs, + settings = param()$settings$labs, subj_id = selected_subject(), + patient_measures = input$measures) + }, ignoreInit = TRUE) } }, ignoreInit = TRUE) diff --git a/R/patient_profile_mod.R b/R/patient_profile_mod.R index 0c3f94f..2f0e57e 100644 --- a/R/patient_profile_mod.R +++ b/R/patient_profile_mod.R @@ -30,7 +30,7 @@ patientProfileUI <- function(id) { #' @import dplyr #' @importFrom plotly renderPlotly #' @importFrom magrittr %>% -patientProfileServer <- function(id, df, settings, subj_id) { +patientProfileServer <- function(id, df, settings, subj_id, patient_measures) { moduleServer( id, function(input, output, session) { @@ -88,23 +88,24 @@ patientProfileServer <- function(id, df, settings, subj_id) { output$ULN_FC <- renderUI({ - default_labs <- c(settings$measure_values$BICARB, - settings$measure_values$BUN, - settings$measure_values$CA, - settings$measure_values$CL, - settings$measure_values$PHOS, - settings$measure_values$K, - settings$measure_values$SODIUM) - - available_labs <- intersect(patient_df[[settings$measure_col]] %>% unique(), default_labs) - - if (length(available_labs) > 0) { - drawULNFoldChange(adlb = patient_df, settings = settings, - labs = available_labs) - } else { - div() - } - }) + # default_labs <- c(settings$measure_values$BICARB, + # settings$measure_values$BUN, + # settings$measure_values$CA, + # settings$measure_values$CL, + # settings$measure_values$PHOS, + # settings$measure_values$K, + # settings$measure_values$SODIUM) + + available_labs <- intersect(patient_df[[settings$measure_col]] %>% unique(), patient_measures) + + if (length(available_labs) > 0) { + drawULNFoldChange(adlb = patient_df, + settings = settings, + labs = available_labs) + } else { + div() + } + }) output$blood_pressure <- renderUI({ diff --git a/man/patientProfileServer.Rd b/man/patientProfileServer.Rd index 60c77d3..4b86665 100644 --- a/man/patientProfileServer.Rd +++ b/man/patientProfileServer.Rd @@ -4,7 +4,7 @@ \alias{patientProfileServer} \title{Patient Profile Module Server} \usage{ -patientProfileServer(id, df, settings, subj_id) +patientProfileServer(id, df, settings, subj_id, patient_measures) } \arguments{ \item{id}{module id} From ba62c6d4b4867bc3906425a6b42f4d6e3e5db488 Mon Sep 17 00:00:00 2001 From: Lovemore Gakava Date: Fri, 4 Oct 2024 21:19:41 +0000 Subject: [PATCH 2/8] fix: extend color palatte to accomodate more lab tests beyond the default. --- R/patient_profile_charts.R | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/R/patient_profile_charts.R b/R/patient_profile_charts.R index 25ce4fc..7dce629 100644 --- a/R/patient_profile_charts.R +++ b/R/patient_profile_charts.R @@ -189,6 +189,22 @@ drawULNFoldChange <- function(adlb, settings, .data[[settings$normal_col_high]]) %>% ungroup() + + # Get the initial colors from Set1, excluding the 6th color + initial_colors <- brewer.pal(9, "Set1")[-6] + + # Choose another palette for extending + extend_palette <- brewer.pal(11, "Spectral") + + # Combine the palettes + combined_palette <- c(initial_colors, extend_palette) + + # Create a color generator function + color_generator <- colorRampPalette(combined_palette) + + # Generate a large number of colors + + p <- ggplot(adlb_FC, aes(x = .data[[settings$studyday_col]], y = .data$FOLD_CHG, color = .data[[settings$measure_col]], group = .data[[settings$measure_col]], text = paste0("Study Day: ", .data[[settings$studyday_col]], "\n", @@ -201,7 +217,7 @@ drawULNFoldChange <- function(adlb, settings, theme(legend.title = element_blank()) + #remove legend title ylab("xULN (Fold Change)") + xlab("Study Day") + - scale_colour_manual(values = brewer.pal(9, "Set1")[-6], name = "Lab Test") + # drop yellow + scale_colour_manual(values = color_generator(100), name = "Lab Test") + # drop yellow ## Add ULN Annotation geom_hline(yintercept = 1, linetype = "dashed", color = "gray") + From f964bbb4f4517d95aa85d0e1b4a362882323b120 Mon Sep 17 00:00:00 2001 From: Lovemore Gakava Date: Sun, 6 Oct 2024 19:39:32 +0100 Subject: [PATCH 3/8] Update picker. --- .vscode/settings.json | 5 +++++ R/nepexplorerMod.R | 4 ++-- 2 files changed, 7 insertions(+), 2 deletions(-) create mode 100644 .vscode/settings.json diff --git a/.vscode/settings.json b/.vscode/settings.json new file mode 100644 index 0000000..fd77730 --- /dev/null +++ b/.vscode/settings.json @@ -0,0 +1,5 @@ +{ + "r.rterm.windows": "C:\\Program Files\\R\\R-4.4.1\\bin\\R.exe", + "r.rpath.windows": "C:\\Program Files\\R\\R-4.4.1\\bin\\R.exe", + "terminal.integrated.defaultProfile.windows": "R" +} \ No newline at end of file diff --git a/R/nepexplorerMod.R b/R/nepexplorerMod.R index 8634756..cdb1b89 100644 --- a/R/nepexplorerMod.R +++ b/R/nepexplorerMod.R @@ -12,7 +12,7 @@ nepexplorer_ui <- function(id) { #future home of settings panel sidebar <- sidebarPanel( - selectizeInput( + pickerInput( ns("measures"), "Select Patient Profile Fold Change Measures", multiple = TRUE, @@ -118,7 +118,7 @@ nepexplorer_server <- function(input, output, session, params) { # update selectize to reflect what's specific in metadata - updateSelectizeInput(session, + updatePickerInput(session, "measures", choices = measures, selected = fold_change_measures From 577e1c149cf0371564491b956390fcc99b508d1d Mon Sep 17 00:00:00 2001 From: Lovemore Gakava Date: Sun, 6 Oct 2024 20:05:36 +0100 Subject: [PATCH 4/8] Added shinyWidgets package declaration for pickerInput --- R/nepexplorerMod.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/nepexplorerMod.R b/R/nepexplorerMod.R index cdb1b89..8c669b3 100644 --- a/R/nepexplorerMod.R +++ b/R/nepexplorerMod.R @@ -12,7 +12,7 @@ nepexplorer_ui <- function(id) { #future home of settings panel sidebar <- sidebarPanel( - pickerInput( + shinyWidgets::pickerInput( ns("measures"), "Select Patient Profile Fold Change Measures", multiple = TRUE, @@ -118,7 +118,7 @@ nepexplorer_server <- function(input, output, session, params) { # update selectize to reflect what's specific in metadata - updatePickerInput(session, + shinyWidgets::updatePickerInput(session, "measures", choices = measures, selected = fold_change_measures From a4b3d02f97cc0918e68c6d32554c1c60f23f412e Mon Sep 17 00:00:00 2001 From: Lovemore Gakava Date: Sun, 13 Oct 2024 21:46:28 +0100 Subject: [PATCH 5/8] fix: patient_profile_mod.R,line=148,col=2,[trailing_blank_lines_linter] added Missing terminal newline patient_profile_charts.R: added importFrom grDevices colorRampPalette --- DESCRIPTION | 5 +++-- NAMESPACE | 1 + R/patient_profile_charts.R | 1 + R/patient_profile_mod.R | 2 +- 4 files changed, 6 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 5a78fca..bf302ce 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -20,14 +20,15 @@ Imports: shiny, dplyr, ggplot2, - RColorBrewer, + RColorBrewer, magrittr, plotly (>= 4.0.0), gt, htmlwidgets, scales, rlang, - shinyjs + shinyjs, + grDevices Suggests: safetyGraphics, safetyData diff --git a/NAMESPACE b/NAMESPACE index 36fcda5..fdb15bd 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -10,6 +10,7 @@ import(dplyr) import(ggplot2) import(gt) import(shiny) +importFrom(grDevices,colorRampPalette) importFrom(gt,gt_output) importFrom(gt,render_gt) importFrom(htmlwidgets,onRender) diff --git a/R/patient_profile_charts.R b/R/patient_profile_charts.R index 7dce629..e63a4b8 100644 --- a/R/patient_profile_charts.R +++ b/R/patient_profile_charts.R @@ -174,6 +174,7 @@ drawRawChange <- function(adlb, settings, labs = c("Creatinine", "Cystatin C"), #' @import RColorBrewer #' @importFrom plotly ggplotly #' @importFrom plotly config +#' @importFrom grDevices colorRampPalette #' @return ggplot object drawULNFoldChange <- function(adlb, settings, labs = c("Bicarbonate", "Blood Urea Nitrogen", diff --git a/R/patient_profile_mod.R b/R/patient_profile_mod.R index 9ee8f4d..0db8384 100644 --- a/R/patient_profile_mod.R +++ b/R/patient_profile_mod.R @@ -145,4 +145,4 @@ patientProfileServer <- function(id, df, selected_measures, settings, subj_id) } ) -} \ No newline at end of file +} From e68aab42b9ec55a46360611770855f1595dec3cb Mon Sep 17 00:00:00 2001 From: Lovemore Gakava Date: Sun, 13 Oct 2024 21:52:18 +0100 Subject: [PATCH 6/8] rm: Non-standard file/directory found at top level: '_pkgdown.yml --- _pkgdown.yml | 4 ---- 1 file changed, 4 deletions(-) delete mode 100644 _pkgdown.yml diff --git a/_pkgdown.yml b/_pkgdown.yml deleted file mode 100644 index 94ce6c2..0000000 --- a/_pkgdown.yml +++ /dev/null @@ -1,4 +0,0 @@ -url: https://safetygraphics.github.io/nepExplorer/ -template: - bootstrap: 5 - From e1ac576ba73be134a6b0e2bbc8ebfd58e9d3a6ba Mon Sep 17 00:00:00 2001 From: Lovemore Gakava Date: Sun, 13 Oct 2024 22:11:53 +0100 Subject: [PATCH 7/8] fix: add shinywidgets dependency. --- .vscode/settings.json | 5 ----- DESCRIPTION | 3 ++- _pkgdown.yml | 4 ++++ 3 files changed, 6 insertions(+), 6 deletions(-) delete mode 100644 .vscode/settings.json create mode 100644 _pkgdown.yml diff --git a/.vscode/settings.json b/.vscode/settings.json deleted file mode 100644 index fd77730..0000000 --- a/.vscode/settings.json +++ /dev/null @@ -1,5 +0,0 @@ -{ - "r.rterm.windows": "C:\\Program Files\\R\\R-4.4.1\\bin\\R.exe", - "r.rpath.windows": "C:\\Program Files\\R\\R-4.4.1\\bin\\R.exe", - "terminal.integrated.defaultProfile.windows": "R" -} \ No newline at end of file diff --git a/DESCRIPTION b/DESCRIPTION index bf302ce..37f00ab 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -28,7 +28,8 @@ Imports: scales, rlang, shinyjs, - grDevices + grDevices, + shinyWidgets Suggests: safetyGraphics, safetyData diff --git a/_pkgdown.yml b/_pkgdown.yml new file mode 100644 index 0000000..94ce6c2 --- /dev/null +++ b/_pkgdown.yml @@ -0,0 +1,4 @@ +url: https://safetygraphics.github.io/nepExplorer/ +template: + bootstrap: 5 + From 4c6b47edf363e956e1cf24952a61385097170d62 Mon Sep 17 00:00:00 2001 From: Preston Burns Date: Fri, 25 Oct 2024 20:43:19 +0000 Subject: [PATCH 8/8] only use generator if more than 19 labs selected for fold change chart --- NAMESPACE | 1 + R/nepexplorerMod.R | 1 + R/patient_profile_charts.R | 10 +++++++--- 3 files changed, 9 insertions(+), 3 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index fdb15bd..39167d6 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -25,6 +25,7 @@ importFrom(plotly,renderPlotly) importFrom(rlang,":=") importFrom(rlang,.data) importFrom(scales,percent_format) +importFrom(shinyWidgets,pickerInput) importFrom(shinyjs,hidden) importFrom(shinyjs,hide) importFrom(shinyjs,show) diff --git a/R/nepexplorerMod.R b/R/nepexplorerMod.R index 8c669b3..74bd745 100644 --- a/R/nepexplorerMod.R +++ b/R/nepexplorerMod.R @@ -6,6 +6,7 @@ #' @import shiny #' @importFrom shinyjs useShinyjs #' @importFrom shinyjs hidden +#' @importFrom shinyWidgets pickerInput #' @export nepexplorer_ui <- function(id) { ns <- NS(id) diff --git a/R/patient_profile_charts.R b/R/patient_profile_charts.R index e63a4b8..fd56a99 100644 --- a/R/patient_profile_charts.R +++ b/R/patient_profile_charts.R @@ -203,9 +203,13 @@ drawULNFoldChange <- function(adlb, settings, # Create a color generator function color_generator <- colorRampPalette(combined_palette) - # Generate a large number of colors + # if more than 19 labs selected, bring in the generator + color_scale <- if (length(labs) <= 19) { + color_scale <- combined_palette + } else { + color_scale <- color_generator(100) + } - p <- ggplot(adlb_FC, aes(x = .data[[settings$studyday_col]], y = .data$FOLD_CHG, color = .data[[settings$measure_col]], group = .data[[settings$measure_col]], text = paste0("Study Day: ", .data[[settings$studyday_col]], "\n", @@ -218,7 +222,7 @@ drawULNFoldChange <- function(adlb, settings, theme(legend.title = element_blank()) + #remove legend title ylab("xULN (Fold Change)") + xlab("Study Day") + - scale_colour_manual(values = color_generator(100), name = "Lab Test") + # drop yellow + scale_colour_manual(values = color_scale, name = "Lab Test") + # drop yellow ## Add ULN Annotation geom_hline(yintercept = 1, linetype = "dashed", color = "gray") +