From a74289d34dbd7d9986d01b754d5de210f763099e Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Fri, 15 Nov 2024 13:52:54 +0100 Subject: [PATCH 01/93] feat, wip: simple DEMO of tlg implementation --- NAMESPACE | 3 ++ R/g_pkconc_ind.R | 30 ++++++++++++ inst/shiny/global.R | 2 + inst/shiny/modules/tab_tlg.R | 89 +++++++++++++++++++---------------- inst/shiny/modules/tlg_plot.R | 37 +++++++++++++++ inst/shiny/tlg.yaml | 40 ++++++++++++++++ 6 files changed, 161 insertions(+), 40 deletions(-) create mode 100644 R/g_pkconc_ind.R create mode 100644 inst/shiny/modules/tlg_plot.R create mode 100644 inst/shiny/tlg.yaml diff --git a/NAMESPACE b/NAMESPACE index 761a6e3..a4b7fd3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -9,6 +9,9 @@ export(create_dose) export(filter_breaks) export(flexible_violinboxplot) export(format_data) +export(g_pkconc_ind) +export(g_pkconc_ind_lin) +export(g_pkconc_ind_log) export(general_lineplot) export(general_meanplot) export(geometric_mean) diff --git a/R/g_pkconc_ind.R b/R/g_pkconc_ind.R new file mode 100644 index 0000000..67df024 --- /dev/null +++ b/R/g_pkconc_ind.R @@ -0,0 +1,30 @@ +#' TODO: Implement actual pkconc plot +#' @export +g_pkconc_ind <- function(data, scale = "lin", xlab = "test x lab", ylab = "test y lab") { + p <- ggplot2::ggplot( + data = data, + mapping = aes(x = TIME, y = ADOSEDUR) + ) + + ggplot2::geom_point() + + ggplot2::labs( + x = xlab, + y = ylab + ) + + if (scale == "log") { + p <- p + + ggplot2::scale_y_log10() + } + + p +} + +#' @export +g_pkconc_ind_lin <- function(data, ...) { + g_pkconc_ind(data = data, scale = "lin", ...) +} + +#' @export +g_pkconc_ind_log <- function(data, ...) { + g_pkconc_ind(data, scale = "log", ...) +} \ No newline at end of file diff --git a/inst/shiny/global.R b/inst/shiny/global.R index 1458ee7..b72c57d 100644 --- a/inst/shiny/global.R +++ b/inst/shiny/global.R @@ -3,3 +3,5 @@ source("modules/tab_data.R") source("modules/slope_selector.R") source("functions/partial_auc_input.R") + +source("modules/tlg_plot.R") diff --git a/inst/shiny/modules/tab_tlg.R b/inst/shiny/modules/tab_tlg.R index a63701a..7cefab2 100644 --- a/inst/shiny/modules/tab_tlg.R +++ b/inst/shiny/modules/tab_tlg.R @@ -1,3 +1,5 @@ +.TLG_DEFINITIONS <- yaml::read_yaml(system.file("shiny/tlg.yaml", package = "aNCA")) + tab_tlg_ui <- function(id) { ns <- NS(id) @@ -56,29 +58,7 @@ tab_tlg_ui <- function(id) { ) ) ), - tabPanel( - "Graphs", - fluidRow( - column( - 2, # Left column for plot selection - radioButtons( - inputId = ns("buttons_Graphs"), - label = "Choose Graph\n", - choices = "" - ) - ), - column( - 6, # Middle column for plot output - h4("Graph to display"), - plotOutput(ns("plot_Graphs")) - ), - column( - 2, # Right column for plot customization inputs - h4("Inputs with selected vals linked to downloadable obj (i.e, tlg_order())"), - textInput(ns("footnote_Graphs"), label = "Footnote") - ) - ) - ) + tabPanel("Graphs", uiOutput(ns("graphs"))) ) } @@ -87,10 +67,33 @@ tab_tlg_server <- function(id, data) { ns <- session$ns # Make available the CSV file with the TLG list and available links to NEST - tlg_order <- reactiveVal( - read.csv(system.file("www/data/TLG_order_details.csv", package = "aNCA")) %>% - mutate(PKid = paste0("", PKid, "")) - ) + tlg_order <- reactiveVal({ + tlg_data <- dplyr::tibble( + id = character(), + Selection = logical(), + Type = character(), + Dataset = character(), + PKid = character(), + Description = character(), + Footnote = character(), + Stratification = character(), + Condition = character(), + Comment = character() + ) + + purrr::iwalk(.TLG_DEFINITIONS, function(x, id) { + tlg_data <<- dplyr::add_row( + tlg_data, + id = id, + Selection = x$is_default, + Type = x$type, + Dataset = x$dataset, + PKid = paste0("", x$pkid, ""), + Description = x$description + ) + }) + tlg_data + }) # Based on the TLG list conditions for data() define the preselected rows in $Selection observeEvent(list(tlg_order(), data()), { @@ -267,19 +270,25 @@ tab_tlg_server <- function(id, data) { choices = "") } - if (sum(tlg_order_filt$Type == "Graph") > 0) { - updateRadioButtons( - session = session, - inputId = "buttons_Graphs", - label = "Graph to display", - choices = tlg_order_filt$Label[tlg_order_filt$Type == "Graph"] - ) - } else { - updateRadioButtons(session = session, - inputId = "buttons_Graphs", - label = "", - choices = "") - } + tlg_order_graphs <- filter(tlg_order_filt, Type == "Graph")$id + panels <- lapply(tlg_order_graphs, function(g_id) { + plot_ui <- { + g_def <- .TLG_DEFINITIONS[[g_id]] + + if (exists(g_def$fun)) { + tlg_plot_server(g_id, get(g_def$fun), g_def$opts, data) + tlg_plot_ui(session$ns(g_id)) + } else { + tags$div("Plot not implemented yet") + } + } + + tabPanel(g_def$label, plot_ui) + }) + + output$graphs <- renderUI({ + do.call(navlistPanel, panels) + }) }) }) } diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R new file mode 100644 index 0000000..ae85b7d --- /dev/null +++ b/inst/shiny/modules/tlg_plot.R @@ -0,0 +1,37 @@ +tlg_plot_ui <- function(id) { + ns <- NS(id) + + fluidRow( + column( + width = 9, + plotOutput(ns("plot")) + ), + column( + width = 3, + uiOutput(ns("options")) + ) + ) +} + +tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { + moduleServer(id, function(input, output, session) { + output$plot <- renderPlot({ + do.call(render_plot, purrr::list_modify(list(data = data()), !!!reactiveValuesToList(opts))) + }) + + opts <- reactiveValues() + + option_widgets <- lapply(options, function(opt_id) { + observeEvent(input[[opt_id]], { + opts[[opt_id]] <- input[[opt_id]] + }) + + textInput( + session$ns(opt_id), + label = opt_id + ) + }) + + output$options <- renderUI(option_widgets) + }) +} \ No newline at end of file diff --git a/inst/shiny/tlg.yaml b/inst/shiny/tlg.yaml new file mode 100644 index 0000000..e8e4a86 --- /dev/null +++ b/inst/shiny/tlg.yaml @@ -0,0 +1,40 @@ +# Configuration file containing TLG definitions. Each TLG should be a separate entry, with unique ID. +# The TLG entry should have the following format: +# id: +# is_default: # true / false whether TLG should be included as default +# type: # Graph / List / Table +# dataset: # name of the dataset +# pkid: # standarized id of the TLG +# label: # short label to display as tab name +# description: # longer descriptions, to be displayed in the order table +# link: # link to the documentation of the TLG +# fun: # name of the function exported by the package, responsible for generating TLG +# opts: # options that can be passed as arguments to the function +# - option1 # will generate input widgets for editing +# - option2 # TODO: add ability to specify default value and type + +g_pkconc_ind_lin: + is_default: true + type: Graph + dataset: ADPC + pkid: pkcg01 + label: pkcg01 - linear + description: "Individual plots of concentrations vs. time (one plot per patient/subject) with linear scale" + link: https://insightsengineering.github.io/tlg-catalog/stable/graphs/pharmacokinetic/pkcg01.html + fun: g_pkconc_ind_lin + opts: + - xlab + - ylab +g_pkconc_ind_log: + is_default: true + type: Graph + dataset: ADPC + pkid: pkcg01 + label: pkcg01 - log + description: "Individual plots of concentrations vs. time (one plot per patient/subject) with log10 scale" + link: https://insightsengineering.github.io/tlg-catalog/stable/graphs/pharmacokinetic/pkcg01.html + fun: g_pkconc_ind_log + opts: + - xlab + - ylab + \ No newline at end of file From c2b903a7aa037d1539759c457019eb54b34ad25d Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 21 Nov 2024 08:53:06 +0100 Subject: [PATCH 02/93] feat: tlg_plot cleans up user input, adjusted to functions returning plot lists --- inst/shiny/modules/tlg_plot.R | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R index ae85b7d..6412f61 100644 --- a/inst/shiny/modules/tlg_plot.R +++ b/inst/shiny/modules/tlg_plot.R @@ -15,8 +15,19 @@ tlg_plot_ui <- function(id) { tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { moduleServer(id, function(input, output, session) { + plot_list <- reactive({ + plot_options <- purrr::list_modify(list(data = data()), !!!reactiveValuesToList(opts)) + + purrr::iwalk(plot_options, \(value, name) { + if (isTRUE(value == "")) + plot_options[[name]] <<- NULL + }) + + do.call(render_plot, plot_options) + }) + output$plot <- renderPlot({ - do.call(render_plot, purrr::list_modify(list(data = data()), !!!reactiveValuesToList(opts))) + plot_list()[[1]] }) opts <- reactiveValues() From 19f519b06c61e747fbcd29e0bc09f5001c62a93e Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 28 Nov 2024 08:18:57 +0100 Subject: [PATCH 03/93] feat: working page selection --- inst/shiny/modules/tlg_plot.R | 45 ++++++++++++++++++++++++++++++++++- inst/shiny/www/style.css | 14 +++++++++++ 2 files changed, 58 insertions(+), 1 deletion(-) diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R index 6412f61..663aef3 100644 --- a/inst/shiny/modules/tlg_plot.R +++ b/inst/shiny/modules/tlg_plot.R @@ -4,6 +4,22 @@ tlg_plot_ui <- function(id) { fluidRow( column( width = 9, + fluidRow( + class = "plot-widgets-container", + div(align = "left", shinyjs::disabled(actionButton(ns("previous_page"), "Previous Page"))), + div( + align = "center", + tags$span( + class = "inline-select-input", + tags$span("Page "), + uiOutput(ns("select_page_ui")), + tags$span(" out of "), + uiOutput(ns("page_number"), inline = TRUE) + ) + ), + div(align = "right", actionButton(ns("next_page"), "Next Page")) + ), + # Plots display # plotOutput(ns("plot")) ), column( @@ -15,6 +31,33 @@ tlg_plot_ui <- function(id) { tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { moduleServer(id, function(input, output, session) { + current_page <- reactiveVal(1) + + #' updating current page based on user input + observeEvent(input$next_page, current_page(current_page() + 1)) + observeEvent(input$previous_page, current_page(current_page() - 1)) + observeEvent(input$select_page, current_page(as.numeric(input$select_page))) + + observeEvent(data(), { + current_page(1) + output$page_number <- renderUI(length(plot_list())) + output$select_page_ui <- renderUI({ + selectInput( + inputId = session$ns("select_page"), + label = "", + choices = seq_len(length(plot_list())), + selected = 1 + ) + }) + }) + + observeEvent(current_page(), { + shinyjs::toggleState(id = "previous_page", condition = current_page() > 1) + shinyjs::toggleState(id = "next_page", condition = current_page() < length(plot_list())) + updateSelectInput(session = session, inputId = "select_page", selected = current_page()) + }) + + plot_list <- reactive({ plot_options <- purrr::list_modify(list(data = data()), !!!reactiveValuesToList(opts)) @@ -27,7 +70,7 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { }) output$plot <- renderPlot({ - plot_list()[[1]] + plot_list()[[current_page()]] }) opts <- reactiveValues() diff --git a/inst/shiny/www/style.css b/inst/shiny/www/style.css index fde4db9..d04a0ce 100644 --- a/inst/shiny/www/style.css +++ b/inst/shiny/www/style.css @@ -136,3 +136,17 @@ top: 3px; } } + +.inline-select-input > div, +.inline-select-input > div > div { + width: 5em !important; + text-align: left !important; + display: inline-block !important; +} + +.plot-widgets-container { + display: flex; + justify-content: space-around; + align-items: baseline; + margin-bottom: 1em; + } \ No newline at end of file From d4c24e00fb07e4aa10629c2270907d7590a8b7c0 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 28 Nov 2024 08:42:41 +0100 Subject: [PATCH 04/93] feat, wip: basic implementation of pckg01 plot --- R/g_pkconc_ind.R | 362 +++++++++++++++++++++++++++++++++++++++++--- inst/shiny/tlg.yaml | 13 +- 2 files changed, 353 insertions(+), 22 deletions(-) diff --git a/R/g_pkconc_ind.R b/R/g_pkconc_ind.R index 67df024..963cfc3 100644 --- a/R/g_pkconc_ind.R +++ b/R/g_pkconc_ind.R @@ -1,30 +1,352 @@ -#' TODO: Implement actual pkconc plot +#' Wrapper around aNCA::pkcg01() function. Calls the function with `LIN` scale argument. +#' @param data Data to be passed into the plotting function. +#' @param ... Any other parameters to be passed into the ploting function. +#' @returns ggplot2 object for pckg01. #' @export -g_pkconc_ind <- function(data, scale = "lin", xlab = "test x lab", ylab = "test y lab") { - p <- ggplot2::ggplot( - data = data, - mapping = aes(x = TIME, y = ADOSEDUR) - ) + - ggplot2::geom_point() + - ggplot2::labs( - x = xlab, - y = ylab +g_pkconc_ind_lin <- function(data, ...) { + pkcg01(adpc = data, scale = "LIN", ...) +} + +#' Wrapper around aNCA::pkcg01() function. Calls the function with `LOG` scale argument. +#' @param data Data to be passed into the plotting function. +#' @param ... Any other parameters to be passed into the ploting function. +#' @returns ggplot2 object for pckg01. +#' @export +g_pkconc_ind_log <- function(data, ...) { + pkcg01(adpc = data, scale = "LOG") +} + +#' Generate PK Concentration-Time Profile Plots +#' +#' This function generates a list of ggplots for PK concentration-time profiles. +#' +#' @param adpc A data frame containing the data. +#' @param xvar A character string of the variable name for the x-axis. +#' @param yvar A character string of the variable name for the y-axis. +#' @param xvar_unit A character string of the unit for the x-axis variable. +#' @param yvar_unit A character string of the unit for the y-axis variable. +#' @param color_var A character string of the variable name for the color. +#' @param color_var_label A character string of the color label. +#' @param xbreaks_var A character string of the x-axis breaks. +#' @param xmin A numeric value specifying the minimum x-axis limit. +#' @param xmax A numeric value specifying the maximum x-axis limit. +#' @param ymin A numeric value for the minimum y-axis limit. +#' @param ymax A numeric value for the maximum y-axis limit. +#' @param xlab Character for x-axis label. Defaults: `xvar` label & `xvar_unit`. +#' @param ylab Character for y-axis label. Defaults: `yvar` label & `yvar_unit`. +#' @param footnote A character string of a manual footnote for the plot. +#' @param plotgroup_vars A character vector of the variables to group data. +#' @param plotgroup_names A character vector of the grouping variable names. +#' @param options A list of additional options (e.g., display scale). +#' @param studyid A character string specifying the study ID variable. +#' @param trt_var A character string specifying the treatment variable. +#' @returns A list of ggplot objects for each unique group. +#' @importFrom dplyr mutate across rowwise ungroup group_by n +#' @importFrom ggplot2 aes scale_x_continuous labs +#' @importFrom tern g_ipp # Can be substituted by regular ggplot easily!! +#' @importFrom checkmate assert_numeric +#' @importFrom scales breaks_log label_log trans_breaks trans_formats +#' @importFrom ggh4x scale_y_facet +#' +#' @examples +#' \dontrun { +#' adpc <- read.csv("inst/shiny/data/DummyRO_ADNCA.csv") +#' attr(adpc[["AFRLT"]], "label") <- "Actual time from first dose" +#' attr(adpc[["AVAL"]], "label") <- "Analysis val +#' +#' plots_lin <- pkcg01(adpc = adpc, xmax = 1) +#' plots_log <- pkcg01(adpc = adpc, color_var = "USUBJID", scale = "LOG) +#' plots_sbs <- pkcg01( +#' adpc = adpc, +#' color_var = "USUBJID", +#' xbreaks_var = "NFRLT", +#' xmin = 100, xmax = 1000, +#' scale = "SBS" +#' ) +#' } +#' +#' @export +#' @author Gerardo Rodriguez +pkcg01 <- function( + adpc = data(), + xvar = "AFRLT", + yvar = "AVAL", + xvar_unit = "RRLTU", + yvar_unit = "AVALU", + color_var = NULL, + color_var_label = NULL, + xbreaks_var = "NFRLT", + xbreaks_mindist = 0.5, + xmin = NA, + xmax = NA, + ymin = NA, + ymax = NA, + # xlab = substitute(paste0(attr(adpc[[xvar]], "label"), + # " (", unique(adpc[[xvar_unit]]), ")")), + # ylab = substitute(paste0(attr(adpc[[yvar]], "label"), + # " (", unique(adpc[[yvar_unit]]), ")")), + xlab = paste0(xvar, " [", xvar_unit, "]"), + ylab = paste0(yvar, " [", yvar_unit, "]"), + footnote = NULL, + # Inputs to split-by/seggregate plots + plotgroup_vars = c("ROUTE", "PCSPEC", "PARAM", "USUBJID"), + plotgroup_names = c("Route", "Specimen", "Analyte", "Subject ID"), + + # Specific inputs (needs metadata specification), + scale = c("LIN", "LOG", "SBS")[1], + studyid = "STUDYID", + trt_var = "TRT01A" +) { + + xmin <- as.numeric(xmin) + xmax <- as.numeric(xmax) + ymin <- as.numeric(ymin) + ymax <- as.numeric(ymax) + + # Title for the plots based on display option + title <- paste0( + "Plot of PK Concentration-Time Profile ", + dplyr::case_when( + scale == "LIN" ~ "linear", + scale == "LOG" ~ "logarithmic", + TRUE ~ "linear and logarithmic" + ), + " scale" + ) + + # Include in data figure details: title, subtitle, footnote/caption + adpc <- add_figure_details( + adpc = adpc, + title = title, + collapse_subtitle = ", ", + studyid = studyid, # Includes cohort in title + trt_var = trt_var, # Includes treatment in subtitle + plotgroup_vars = plotgroup_vars, + plotgroup_names = plotgroup_names, + xvar_unit = xvar_unit, + xmin = as.numeric(xmin), + xmax = as.numeric(xmax), + footnote = footnote + ) + + # Construct the reference ggplot object + plot_data <- adpc %>% filter(id_plot == id_plot[1]) + + plot <- tern::g_ipp( + df = plot_data, + xvar = xvar, + yvar = yvar, + xlab = xlab, + ylab = ylab, + id_var = "subtitle", + add_baseline_hline = FALSE, + yvar_baseline = yvar, + title = unique(plot_data$title), + subtitle = unique(plot_data$subtitle), + caption = unique(plot_data$footnote), + plotting_choices = "separate_by_obs" + )[[1]] + + # Provide limits and additional potential future aesthetic customizations + plot <- plot + + aes(color = NULL) + + theme( + plot.title = element_text(family = "sans", size = 14, color = "black"), + plot.subtitle = element_text(family = "sans", size = 11, color = "black") + ) + + coord_cartesian(xlim = c(xmin, xmax), ylim = c(ymin, ymax)) + + # Ensure x breaks labels do not overlap graphically + plot <- plot + + scale_x_continuous( + guide = guide_axis(n.dodge = 1), + breaks = filter_breaks( + x_breaks = plot_data[[xbreaks_var]], + min_cm_distance = xbreaks_mindist, + plot = plot + ), + labels = \(x) ifelse(x %% 1 == 0, as.character(as.integer(x)), as.character(x)) ) - if (scale == "log") { - p <- p + - ggplot2::scale_y_log10() + # Add color when specified + if (!is.null(color_var)) { + plot <- plot + + aes(color = !!sym(color_var)) + + theme(legend.position = "none") + } + + # Add color legend only when neccessary + if (!is.null(color_var_label) && length(color_var) > 1) { + plot <- plot + + labs(color = if (!is.null(color_var_label)) color_var_label else color_var) + + theme(legend.position = "bottom") + } + + + if (scale == "LOG") { + # Create LOG version of data and plot + adpc <- adpc %>% + dplyr::mutate(across(all_of(yvar), ~ ifelse(. < 1e-3, 1e-3, .))) + + plot <- plot %+% dplyr::filter(adpc, id_plot == id_plot[1]) + + scale_y_continuous( + trans = scales::log10_trans(), + breaks = scales::trans_breaks("log10", \(x) 10^x), + labels = scales::trans_format("log10", scales::math_format(10^.x)) + ) + + annotation_logticks(sides = "l") + + labs(y = paste0("Log 10 - ", plot$labels$y)) + } + + if (scale == "SBS") { + # Create SBS version of data and plot + adpc <- rbind(adpc, adpc) %>% + dplyr::mutate( + view = c(rep("Linear view", nrow(adpc)), rep("Semilogarithmic view (Log10)", nrow(adpc))), + !!sym(yvar) := ifelse( + !!sym(yvar) < 1e-3 & view == "Semilogarithmic view (Log10)", yes = 1e-3, no = !!sym(yvar) + ) + ) + + plot <- plot %+% dplyr::filter(adpc, id_plot == unique(id_plot)[1]) + + facet_wrap(~ view, scales = "free_y") + + annotation_logticks(sides = "l", linewidth = 0.1, alpha = c(0, 1)) + + ggh4x::scale_y_facet( + view == "Semilogarithmic view (Log10)", + trans = "log10", + breaks = scales::breaks_log(), + labels = scales::label_log() + ) + } + + # Create the list of plots for each unique group + plot_list <- list() + for (id_val in unique(adpc[["id_plot"]])) { + + plot_data <- adpc %>% dplyr::filter(id_plot == id_val) + plot_list <- c(plot_list, list(plot %+% plot_data)) } - p + # Define IDs to differentiate each group of plots + names(plot_list) <- unique(adpc[["id_plot"]]) + + # Return the list of plots as output of the function + return(plot_list) } -#' @export -g_pkconc_ind_lin <- function(data, ...) { - g_pkconc_ind(data = data, scale = "lin", ...) +#' Add Figure Details to Data Frame +#' +#' This function adds figure details; title, subtitle, and caption to the data. +#' +#' @param adpc A data frame containing the data. +#' @param plotgroup_vars A character vector of the grouping data variables. +#' @param plotgroup_names A character vector for the grouping variables names. +#' @param studyid A character string specifying the study ID variable. +#' @param xvar_unit A character string for the unit for the x-axis variable. +#' @param xmin A numeric value specifying the minimum x-axis limit. +#' @param xmax A numeric value specifying the maximum x-axis limit. +#' @param footnote A character string specifying plot's manual footnote. +#' @param trt_var A character string specifying the treatment variable. +#' @param title A character string specifying the title for the plot. +#' @returns A data frame with added figure details. +#' @importFrom dplyr mutate across rowwise ungroup group_by n +#' @author Gerardo Rodriguez +add_figure_details <- function( + adpc, + title = "", # Specified by metadata + collapse_subtitle = "\n", + studyid = NULL, # Include or not in t + trt_var, # Include or not in subtitle + plotgroup_vars, + plotgroup_names, + xvar_unit, + xmin = NA, + xmax = NA, + footnote = NULL +) { + adpc %>% + mutate(across(all_of(plotgroup_vars), as.character)) %>% + rowwise() %>% + dplyr::mutate( + title = if (is.null(studyid)) title else paste0(title, ", by Cohort: ", !!sym(studyid)), + subtitle = paste( + paste(c(plotgroup_names), ": ", c_across(all_of(plotgroup_vars)), sep = ""), + collapse = collapse_subtitle + ), + footnote = { + footnote <- ifelse( + is.na(xmax), + yes = "", + no = paste0("Plot not showing observations beyond ", xmax, " ", !!sym(xvar_unit), ".") + ) + if (!is.na(xmin)) { + footnote <- paste0( + footnote, "\nPlot not showing observations before ", xmin, " ", !!sym(xvar_unit), "." + ) + } + + if (!is.null(footnote)) + footnote <- footnote + + footnote + } + ) %>% + ungroup() %>% + dplyr::mutate(id_plot = interaction(!!!syms(plotgroup_vars))) %>% + dplyr::group_by(!!!syms(c(trt_var, plotgroup_vars))) %>% + dplyr::mutate( + subtitle = paste0("Treatment Group: ", !!sym(trt_var), " (N=", n(), ")\n", subtitle) + ) %>% + ungroup() } -#' @export -g_pkconc_ind_log <- function(data, ...) { - g_pkconc_ind(data, scale = "log", ...) +#' Filter Breaks for X-Axis +#' +#' Filters X-axis for consecutive breaks with at least the specified distance. +#' +#' @param x_breaks A numeric vector of x-axis breaks. +#' @param plot A ggplot object used to extract plot dimensions and scales. +#' @param min_cm_distance A numeric of the minimum distance between breaks. +#' @returns A numeric vector of filtered x-axis breaks. +#' @importFrom ggplot2 ggplot_build ggplot_gtable +#' @importFrom grid convertUnit +#' @author Gerardo Rodriguez +filter_breaks <- function(x_breaks = NA, plot = plot, min_cm_distance = 0.5) { + x_breaks <- unique(na.omit(sort(x_breaks))) + plot_build <- ggplot_build(plot) + plot_table <- ggplot_gtable(plot_build) + + # Extract x-axis scale information + x_scale <- plot_build$layout$panel_params[[1]]$x.range + + # Identify the panel grob + panel_index <- which(sapply(plot_table$grobs, \(x) grepl("panel", x$name))) + + if (length(panel_index) == 0) { + stop("Error: Panel grob not found.") + } + panel <- plot_table$grobs[[panel_index]] + + # Extract the panel border grob to get the width + panel_border <- panel$children[[ + which(sapply(panel$children, \(x) grepl("panel.border", x$name))) + ]] + + # Convert panel width to cm + panel_width_cm <- grid::convertUnit(panel_border$width, unitTo = "cm", valueOnly = TRUE) + + # Filter only breaks that satisfy the minimum distance + filt_breaks <- x_breaks[1] + + for (i in 2:length(x_breaks)) { + # Take latest selected break and calculate its distance + b0 <- filt_breaks[length(filt_breaks)] + bdist <- (x_breaks[i] - b0) / diff(x_scale) * panel_width_cm + + if (bdist >= min_cm_distance) { + filt_breaks <- c(filt_breaks, x_breaks[i]) + } + } + + filt_breaks } \ No newline at end of file diff --git a/inst/shiny/tlg.yaml b/inst/shiny/tlg.yaml index e8e4a86..e23aeef 100644 --- a/inst/shiny/tlg.yaml +++ b/inst/shiny/tlg.yaml @@ -22,9 +22,14 @@ g_pkconc_ind_lin: description: "Individual plots of concentrations vs. time (one plot per patient/subject) with linear scale" link: https://insightsengineering.github.io/tlg-catalog/stable/graphs/pharmacokinetic/pkcg01.html fun: g_pkconc_ind_lin - opts: + opts: + - footnote - xlab - ylab + - xmin + - xmax + - ymin + - ymax g_pkconc_ind_log: is_default: true type: Graph @@ -35,6 +40,10 @@ g_pkconc_ind_log: link: https://insightsengineering.github.io/tlg-catalog/stable/graphs/pharmacokinetic/pkcg01.html fun: g_pkconc_ind_log opts: + - footnote - xlab - ylab - \ No newline at end of file + - xmin + - xmax + - ymin + - ymax \ No newline at end of file From db1304d78bf94d475de234b7cd9927b07959aa88 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 28 Nov 2024 13:14:25 +0100 Subject: [PATCH 05/93] feat: support for numeric and text values --- inst/shiny/modules/tlg_plot.R | 20 ++++++++++++----- inst/shiny/tlg.yaml | 42 +++++++++++++++++++++++------------ 2 files changed, 42 insertions(+), 20 deletions(-) diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R index 663aef3..67e83b7 100644 --- a/inst/shiny/modules/tlg_plot.R +++ b/inst/shiny/modules/tlg_plot.R @@ -62,7 +62,7 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { plot_options <- purrr::list_modify(list(data = data()), !!!reactiveValuesToList(opts)) purrr::iwalk(plot_options, \(value, name) { - if (isTRUE(value == "")) + if (isTRUE(value %in% c(NULL, "", 0))) plot_options[[name]] <<- NULL }) @@ -75,15 +75,23 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { opts <- reactiveValues() - option_widgets <- lapply(options, function(opt_id) { + option_widgets <- purrr::imap(options, function(opt_def, opt_id) { observeEvent(input[[opt_id]], { opts[[opt_id]] <- input[[opt_id]] }) - textInput( - session$ns(opt_id), - label = opt_id - ) + if (opt_def$type == "text") { + textInput( + session$ns(opt_id), + label = opt_id + ) + } else if (opt_def$type == "numeric") { + numericInput( + session$ns(opt_id), + label = opt_id, + value = 0 + ) + } }) output$options <- renderUI(option_widgets) diff --git a/inst/shiny/tlg.yaml b/inst/shiny/tlg.yaml index e23aeef..3ea9201 100644 --- a/inst/shiny/tlg.yaml +++ b/inst/shiny/tlg.yaml @@ -23,13 +23,20 @@ g_pkconc_ind_lin: link: https://insightsengineering.github.io/tlg-catalog/stable/graphs/pharmacokinetic/pkcg01.html fun: g_pkconc_ind_lin opts: - - footnote - - xlab - - ylab - - xmin - - xmax - - ymin - - ymax + footnote: + type: text + xlab: + type: text + ylab: + type: text + xmin: + type: numeric + xmax: + type: numeric + ymin: + type: numeric + ymax: + type: numeric g_pkconc_ind_log: is_default: true type: Graph @@ -40,10 +47,17 @@ g_pkconc_ind_log: link: https://insightsengineering.github.io/tlg-catalog/stable/graphs/pharmacokinetic/pkcg01.html fun: g_pkconc_ind_log opts: - - footnote - - xlab - - ylab - - xmin - - xmax - - ymin - - ymax \ No newline at end of file + footnote: + type: text + xlab: + type: text + ylab: + type: text + xmin: + type: numeric + xmax: + type: numeric + ymin: + type: numeric + ymax: + type: numeric \ No newline at end of file From 923fafa894b28d7e15620de8b6018df99ede2932 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 28 Nov 2024 13:16:13 +0100 Subject: [PATCH 06/93] feat: added support for custom labels for inputs --- inst/shiny/modules/tlg_plot.R | 6 ++++-- inst/shiny/tlg.yaml | 6 ++++++ 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R index 67e83b7..555e32f 100644 --- a/inst/shiny/modules/tlg_plot.R +++ b/inst/shiny/modules/tlg_plot.R @@ -80,15 +80,17 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { opts[[opt_id]] <- input[[opt_id]] }) + label <- if (is.null(opt_def$label)) opt_id else opt_def$label + if (opt_def$type == "text") { textInput( session$ns(opt_id), - label = opt_id + label = label ) } else if (opt_def$type == "numeric") { numericInput( session$ns(opt_id), - label = opt_id, + label = label, value = 0 ) } diff --git a/inst/shiny/tlg.yaml b/inst/shiny/tlg.yaml index 3ea9201..e1023d6 100644 --- a/inst/shiny/tlg.yaml +++ b/inst/shiny/tlg.yaml @@ -25,10 +25,13 @@ g_pkconc_ind_lin: opts: footnote: type: text + label: Footnote xlab: type: text + label: X axis label ylab: type: text + label: Y axis label xmin: type: numeric xmax: @@ -49,10 +52,13 @@ g_pkconc_ind_log: opts: footnote: type: text + label: Footnote xlab: type: text + label: X axis label ylab: type: text + label: Y axis label xmin: type: numeric xmax: From 393152fd4768c28286e1816e1e244783aa3813fe Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 28 Nov 2024 16:14:28 +0100 Subject: [PATCH 07/93] feat: support for select options --- inst/shiny/modules/tlg_plot.R | 39 ++++++++++++++++++++++++----------- inst/shiny/tlg.yaml | 19 ++++++++++++++++- 2 files changed, 45 insertions(+), 13 deletions(-) diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R index 555e32f..dfac27d 100644 --- a/inst/shiny/modules/tlg_plot.R +++ b/inst/shiny/modules/tlg_plot.R @@ -82,18 +82,33 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { label <- if (is.null(opt_def$label)) opt_id else opt_def$label - if (opt_def$type == "text") { - textInput( - session$ns(opt_id), - label = label - ) - } else if (opt_def$type == "numeric") { - numericInput( - session$ns(opt_id), - label = label, - value = 0 - ) - } + switch( + opt_def$type, + text = { + textInput( + session$ns(opt_id), + label = label, + value = "" + ) + }, + numeric = { + numericInput( + session$ns(opt_id), + label = label, + value = 0 + ) + }, + select = { + choices <- if (isTRUE(opt_def$choices == ".colnames")) names(data()) else opt_def$choices + selectInput( + session$ns(opt_id), + label = label, + selected = "", + choices = c("", choices), + multiple = isTRUE(opt_def$multiple) + ) + } + ) }) output$options <- renderUI(option_widgets) diff --git a/inst/shiny/tlg.yaml b/inst/shiny/tlg.yaml index e1023d6..14dcfa3 100644 --- a/inst/shiny/tlg.yaml +++ b/inst/shiny/tlg.yaml @@ -22,7 +22,24 @@ g_pkconc_ind_lin: description: "Individual plots of concentrations vs. time (one plot per patient/subject) with linear scale" link: https://insightsengineering.github.io/tlg-catalog/stable/graphs/pharmacokinetic/pkcg01.html fun: g_pkconc_ind_lin - opts: + opts: + xvar: + type: select + label: X axis + choices: .colnames + yvar: + type: select + label: Y axis + choices: .colnames + plotgroup_vars: + type: select + label: "Grouping variables" + multiple: true + choices: + - ROUTE + - PCSPEC + - PARAM + - USUBJID footnote: type: text label: Footnote From 5888be73cac7d0ff07cb101dadb438c0a7026c83 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 28 Nov 2024 16:14:41 +0100 Subject: [PATCH 08/93] fix: axis units --- R/g_pkconc_ind.R | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/R/g_pkconc_ind.R b/R/g_pkconc_ind.R index 963cfc3..0550202 100644 --- a/R/g_pkconc_ind.R +++ b/R/g_pkconc_ind.R @@ -85,8 +85,8 @@ pkcg01 <- function( # " (", unique(adpc[[xvar_unit]]), ")")), # ylab = substitute(paste0(attr(adpc[[yvar]], "label"), # " (", unique(adpc[[yvar_unit]]), ")")), - xlab = paste0(xvar, " [", xvar_unit, "]"), - ylab = paste0(yvar, " [", yvar_unit, "]"), + xlab = paste0(xvar, " [", unique(adpc[[xvar_unit]]), "]"), + ylab = paste0(yvar, " [", unique(adpc[[yvar_unit]]), "]"), footnote = NULL, # Inputs to split-by/seggregate plots plotgroup_vars = c("ROUTE", "PCSPEC", "PARAM", "USUBJID"), @@ -97,7 +97,6 @@ pkcg01 <- function( studyid = "STUDYID", trt_var = "TRT01A" ) { - xmin <- as.numeric(xmin) xmax <- as.numeric(xmax) ymin <- as.numeric(ymin) From 72499992887296ee74040075be2c98f49aa6ad93 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 28 Nov 2024 16:27:01 +0100 Subject: [PATCH 09/93] fix: footnote --- R/g_pkconc_ind.R | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/R/g_pkconc_ind.R b/R/g_pkconc_ind.R index 0550202..88c9191 100644 --- a/R/g_pkconc_ind.R +++ b/R/g_pkconc_ind.R @@ -273,19 +273,20 @@ add_figure_details <- function( collapse = collapse_subtitle ), footnote = { - footnote <- ifelse( - is.na(xmax), - yes = "", - no = paste0("Plot not showing observations beyond ", xmax, " ", !!sym(xvar_unit), ".") - ) - if (!is.na(xmin)) { + footnote <- if (is.null(footnote)) "" else paste0(footnote, "\n") + + if (!is.na(xmax)) { footnote <- paste0( - footnote, "\nPlot not showing observations before ", xmin, " ", !!sym(xvar_unit), "." + footnote, + "Plot not showing observations beyond ", xmax, " ", !!sym(xvar_unit), ".\n" ) } - if (!is.null(footnote)) - footnote <- footnote + if (!is.na(xmin)) { + footnote <- paste0( + footnote, "Plot not showing observations before ", xmin, " ", !!sym(xvar_unit), ".\n" + ) + } footnote } From 4f86ffe5d7c39b000593e130a3451400d87b5273 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 28 Nov 2024 16:52:46 +0100 Subject: [PATCH 10/93] fix: all plots showing static reference titles and captions --- R/g_pkconc_ind.R | 25 +++++++++++-------------- 1 file changed, 11 insertions(+), 14 deletions(-) diff --git a/R/g_pkconc_ind.R b/R/g_pkconc_ind.R index 88c9191..8b1ab7f 100644 --- a/R/g_pkconc_ind.R +++ b/R/g_pkconc_ind.R @@ -140,9 +140,6 @@ pkcg01 <- function( id_var = "subtitle", add_baseline_hline = FALSE, yvar_baseline = yvar, - title = unique(plot_data$title), - subtitle = unique(plot_data$subtitle), - caption = unique(plot_data$footnote), plotting_choices = "separate_by_obs" )[[1]] @@ -219,18 +216,18 @@ pkcg01 <- function( } # Create the list of plots for each unique group - plot_list <- list() - for (id_val in unique(adpc[["id_plot"]])) { - + lapply(unique(adpc[["id_plot"]]), \(id_val) { plot_data <- adpc %>% dplyr::filter(id_plot == id_val) - plot_list <- c(plot_list, list(plot %+% plot_data)) - } - - # Define IDs to differentiate each group of plots - names(plot_list) <- unique(adpc[["id_plot"]]) - - # Return the list of plots as output of the function - return(plot_list) + plot %+% + labs( + title = unique(plot_data$title), + subtitle = unique(plot_data$subtitle), + caption = unique(plot_data$footnote), + ) %+% + plot_data + + }) |> + setNames(unique(adpc[["id_plot"]])) } #' Add Figure Details to Data Frame From db56b276497d8f5e692f683e10657f8562f40658 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 28 Nov 2024 17:03:24 +0100 Subject: [PATCH 11/93] feat: smaller left selection panel --- inst/shiny/modules/tab_tlg.R | 1 + 1 file changed, 1 insertion(+) diff --git a/inst/shiny/modules/tab_tlg.R b/inst/shiny/modules/tab_tlg.R index 7cefab2..a592766 100644 --- a/inst/shiny/modules/tab_tlg.R +++ b/inst/shiny/modules/tab_tlg.R @@ -286,6 +286,7 @@ tab_tlg_server <- function(id, data) { tabPanel(g_def$label, plot_ui) }) + panels$"widths" <- c(2, 10) output$graphs <- renderUI({ do.call(navlistPanel, panels) }) From b40e0b019b71ba73445ac79e12d27373c520868b Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 28 Nov 2024 17:11:21 +0100 Subject: [PATCH 12/93] feat: converted ggplot to plotly --- R/g_pkconc_ind.R | 3 ++- inst/shiny/modules/tlg_plot.R | 4 ++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/R/g_pkconc_ind.R b/R/g_pkconc_ind.R index 8b1ab7f..c25b31e 100644 --- a/R/g_pkconc_ind.R +++ b/R/g_pkconc_ind.R @@ -224,7 +224,8 @@ pkcg01 <- function( subtitle = unique(plot_data$subtitle), caption = unique(plot_data$footnote), ) %+% - plot_data + plot_data %>% + ggplotly(tooltip = c("x", "y")) }) |> setNames(unique(adpc[["id_plot"]])) diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R index dfac27d..3d932d9 100644 --- a/inst/shiny/modules/tlg_plot.R +++ b/inst/shiny/modules/tlg_plot.R @@ -20,7 +20,7 @@ tlg_plot_ui <- function(id) { div(align = "right", actionButton(ns("next_page"), "Next Page")) ), # Plots display # - plotOutput(ns("plot")) + plotlyOutput(ns("plot")) ), column( width = 3, @@ -69,7 +69,7 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { do.call(render_plot, plot_options) }) - output$plot <- renderPlot({ + output$plot <- renderPlotly({ plot_list()[[current_page()]] }) From cafd11e684fadbe83deb59c76f8e8251f1aeb645 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 12 Dec 2024 08:21:18 +0100 Subject: [PATCH 13/93] refactor: renamed opts to options --- inst/shiny/modules/tab_tlg.R | 2 +- inst/shiny/modules/tlg_plot.R | 4 ++-- inst/shiny/tlg.yaml | 4 ++-- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/inst/shiny/modules/tab_tlg.R b/inst/shiny/modules/tab_tlg.R index a592766..85be925 100644 --- a/inst/shiny/modules/tab_tlg.R +++ b/inst/shiny/modules/tab_tlg.R @@ -276,7 +276,7 @@ tab_tlg_server <- function(id, data) { g_def <- .TLG_DEFINITIONS[[g_id]] if (exists(g_def$fun)) { - tlg_plot_server(g_id, get(g_def$fun), g_def$opts, data) + tlg_plot_server(g_id, get(g_def$fun), g_def$options, data) tlg_plot_ui(session$ns(g_id)) } else { tags$div("Plot not implemented yet") diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R index 3d932d9..de514d4 100644 --- a/inst/shiny/modules/tlg_plot.R +++ b/inst/shiny/modules/tlg_plot.R @@ -73,11 +73,11 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { plot_list()[[current_page()]] }) - opts <- reactiveValues() + options <- reactiveValues() option_widgets <- purrr::imap(options, function(opt_def, opt_id) { observeEvent(input[[opt_id]], { - opts[[opt_id]] <- input[[opt_id]] + options[[opt_id]] <- input[[opt_id]] }) label <- if (is.null(opt_def$label)) opt_id else opt_def$label diff --git a/inst/shiny/tlg.yaml b/inst/shiny/tlg.yaml index 14dcfa3..90e8591 100644 --- a/inst/shiny/tlg.yaml +++ b/inst/shiny/tlg.yaml @@ -22,7 +22,7 @@ g_pkconc_ind_lin: description: "Individual plots of concentrations vs. time (one plot per patient/subject) with linear scale" link: https://insightsengineering.github.io/tlg-catalog/stable/graphs/pharmacokinetic/pkcg01.html fun: g_pkconc_ind_lin - opts: + options: xvar: type: select label: X axis @@ -66,7 +66,7 @@ g_pkconc_ind_log: description: "Individual plots of concentrations vs. time (one plot per patient/subject) with log10 scale" link: https://insightsengineering.github.io/tlg-catalog/stable/graphs/pharmacokinetic/pkcg01.html fun: g_pkconc_ind_log - opts: + options: footnote: type: text label: Footnote From 17cd5331de83f9177620aa6ee4fce7c9bf445657 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 12 Dec 2024 08:23:20 +0100 Subject: [PATCH 14/93] feat: added target=_blank to links in the tlg table --- inst/shiny/modules/tab_tlg.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/inst/shiny/modules/tab_tlg.R b/inst/shiny/modules/tab_tlg.R index 85be925..cf0c8a6 100644 --- a/inst/shiny/modules/tab_tlg.R +++ b/inst/shiny/modules/tab_tlg.R @@ -88,7 +88,7 @@ tab_tlg_server <- function(id, data) { Selection = x$is_default, Type = x$type, Dataset = x$dataset, - PKid = paste0("", x$pkid, ""), + PKid = paste0("", x$pkid, ""), Description = x$description ) }) From 829e664f2034040cef8ddfecc946feae32a82c9f Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 12 Dec 2024 08:41:19 +0100 Subject: [PATCH 15/93] refactor: better tlg talbe generation --- inst/shiny/modules/tab_tlg.R | 37 ++++++++++++------------------------ 1 file changed, 12 insertions(+), 25 deletions(-) diff --git a/inst/shiny/modules/tab_tlg.R b/inst/shiny/modules/tab_tlg.R index cf0c8a6..7cd1484 100644 --- a/inst/shiny/modules/tab_tlg.R +++ b/inst/shiny/modules/tab_tlg.R @@ -68,31 +68,18 @@ tab_tlg_server <- function(id, data) { # Make available the CSV file with the TLG list and available links to NEST tlg_order <- reactiveVal({ - tlg_data <- dplyr::tibble( - id = character(), - Selection = logical(), - Type = character(), - Dataset = character(), - PKid = character(), - Description = character(), - Footnote = character(), - Stratification = character(), - Condition = character(), - Comment = character() - ) - - purrr::iwalk(.TLG_DEFINITIONS, function(x, id) { - tlg_data <<- dplyr::add_row( - tlg_data, - id = id, - Selection = x$is_default, - Type = x$type, - Dataset = x$dataset, - PKid = paste0("", x$pkid, ""), - Description = x$description - ) - }) - tlg_data + purrr::map_dfr(.TLG_DEFINITIONS, ~ dplyr::tibble( + Selection = .x$is_default, + Type = .x$type, + Dataset = .x$dataset, + PKid = paste0("", .x$pkid, ""), + Description = .x$description, + Footnote = NA_character_, + Stratification = NA_character_, + Condition = NA_character_, + Comment = NA_character_ + )) %>% + dplyr::mutate(id = dplyr::row_number(), .before = dplyr::everything()) }) # Based on the TLG list conditions for data() define the preselected rows in $Selection From d0ac1f6f82d14c2efd43467a7f34e9c7e742f471 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 12 Dec 2024 08:52:23 +0100 Subject: [PATCH 16/93] fix: plot module crashing --- inst/shiny/modules/tlg_plot.R | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R index de514d4..c43b61d 100644 --- a/inst/shiny/modules/tlg_plot.R +++ b/inst/shiny/modules/tlg_plot.R @@ -59,7 +59,7 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { plot_list <- reactive({ - plot_options <- purrr::list_modify(list(data = data()), !!!reactiveValuesToList(opts)) + plot_options <- purrr::list_modify(list(data = data()), !!!reactiveValuesToList(options_)) purrr::iwalk(plot_options, \(value, name) { if (isTRUE(value %in% c(NULL, "", 0))) @@ -73,11 +73,10 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { plot_list()[[current_page()]] }) - options <- reactiveValues() - + options_ <- reactiveValues() option_widgets <- purrr::imap(options, function(opt_def, opt_id) { observeEvent(input[[opt_id]], { - options[[opt_id]] <- input[[opt_id]] + options_[[opt_id]] <- input[[opt_id]] }) label <- if (is.null(opt_def$label)) opt_id else opt_def$label From 4479fe7c1c8a43fe6b295865728950785af2112b Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 12 Dec 2024 08:52:56 +0100 Subject: [PATCH 17/93] refactor: removed mixing patterns --- inst/shiny/modules/tab_tlg.R | 5 ++++- inst/shiny/tlg.yaml | 2 +- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/inst/shiny/modules/tab_tlg.R b/inst/shiny/modules/tab_tlg.R index 7cd1484..db1c8a4 100644 --- a/inst/shiny/modules/tab_tlg.R +++ b/inst/shiny/modules/tab_tlg.R @@ -257,7 +257,10 @@ tab_tlg_server <- function(id, data) { choices = "") } - tlg_order_graphs <- filter(tlg_order_filt, Type == "Graph")$id + tlg_order_graphs <- filter(tlg_order_filt, Type == "Graph") %>% + select("id") %>% + pull() + panels <- lapply(tlg_order_graphs, function(g_id) { plot_ui <- { g_def <- .TLG_DEFINITIONS[[g_id]] diff --git a/inst/shiny/tlg.yaml b/inst/shiny/tlg.yaml index 90e8591..72018d4 100644 --- a/inst/shiny/tlg.yaml +++ b/inst/shiny/tlg.yaml @@ -83,4 +83,4 @@ g_pkconc_ind_log: ymin: type: numeric ymax: - type: numeric \ No newline at end of file + type: numeric From 0f068198e654ca214306b5e4c34dc3cd8b27968e Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 12 Dec 2024 09:43:34 +0100 Subject: [PATCH 18/93] docs: updated documentation --- NAMESPACE | 10 +++- inst/shiny/tlg.yaml | 15 ++++-- man/add_figure_details.Rd | 50 ++++++++++++++++++++ man/filter_breaks.Rd | 14 ++++-- man/g_pkconc_ind_lin.Rd | 19 ++++++++ man/g_pkconc_ind_log.Rd | 19 ++++++++ man/pkcg01.Rd | 98 +++++++++++++++++++++++++++++++++++++++ 7 files changed, 215 insertions(+), 10 deletions(-) create mode 100644 man/add_figure_details.Rd create mode 100644 man/g_pkconc_ind_lin.Rd create mode 100644 man/g_pkconc_ind_log.Rd create mode 100644 man/pkcg01.Rd diff --git a/NAMESPACE b/NAMESPACE index a4b7fd3..78a8e5f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -9,7 +9,6 @@ export(create_dose) export(filter_breaks) export(flexible_violinboxplot) export(format_data) -export(g_pkconc_ind) export(g_pkconc_ind_lin) export(g_pkconc_ind_log) export(general_lineplot) @@ -17,6 +16,7 @@ export(general_meanplot) export(geometric_mean) export(has_label) export(lambda_slope_plot) +export(pkcg01) export(pptestcd_dict) export(reshape_pknca_results) export(run_app) @@ -40,6 +40,7 @@ importFrom(PKNCA,PKNCAdata) importFrom(PKNCA,PKNCAdose) importFrom(PKNCA,pk.nca) importFrom(PKNCA,pknca_units_table) +importFrom(checkmate,assert_numeric) importFrom(dplyr,across) importFrom(dplyr,arrange) importFrom(dplyr,case_when) @@ -48,14 +49,17 @@ importFrom(dplyr,filter) importFrom(dplyr,group_by) importFrom(dplyr,left_join) importFrom(dplyr,mutate) +importFrom(dplyr,n) importFrom(dplyr,pull) importFrom(dplyr,rename) importFrom(dplyr,rename_with) +importFrom(dplyr,rowwise) importFrom(dplyr,select) importFrom(dplyr,slice) importFrom(dplyr,summarise) importFrom(dplyr,ungroup) importFrom(dplyr,where) +importFrom(ggh4x,scale_y_facet) importFrom(ggplot2,aes) importFrom(ggplot2,facet_wrap) importFrom(ggplot2,geom_errorbar) @@ -65,6 +69,7 @@ importFrom(ggplot2,ggplot) importFrom(ggplot2,ggplot_build) importFrom(ggplot2,ggplot_gtable) importFrom(ggplot2,labs) +importFrom(ggplot2,scale_x_continuous) importFrom(grid,convertUnit) importFrom(htmlwidgets,JS) importFrom(logger,log_debug) @@ -87,6 +92,9 @@ importFrom(reactable.extras,dropdown_extra) importFrom(reactable.extras,text_extra) importFrom(rio,export_list) importFrom(rmarkdown,render) +importFrom(scales,breaks_log) +importFrom(scales,label_log) +importFrom(scales,trans_breaks) importFrom(shinyBS,bsModal) importFrom(shinyFiles,shinyDirChoose) importFrom(shinyWidgets,dropdown) diff --git a/inst/shiny/tlg.yaml b/inst/shiny/tlg.yaml index 72018d4..06612ab 100644 --- a/inst/shiny/tlg.yaml +++ b/inst/shiny/tlg.yaml @@ -8,11 +8,16 @@ # label: # short label to display as tab name # description: # longer descriptions, to be displayed in the order table # link: # link to the documentation of the TLG -# fun: # name of the function exported by the package, responsible for generating TLG -# opts: # options that can be passed as arguments to the function -# - option1 # will generate input widgets for editing -# - option2 # TODO: add ability to specify default value and type - +# fun: # name of the function exported by the package, responsible for generating TLG, must +# # return a list of plots to be displayed +# options: # options that can be passed as arguments to the function +# optname: # option name, the same as the argument that is passed to the rendering function +# type: # type of the option/widget, one of: text, numeric, select +# label: # label to be displayed in the editing widget +# multiple: # applicable to 'select' type, whether to allow for multiple values to be selected +# choices: # applicable to 'select' type, choices to pick from the dropdown, either specified +# # outright or using a special keyword: + # - .colnames keyword will pull the choices from the data column names g_pkconc_ind_lin: is_default: true type: Graph diff --git a/man/add_figure_details.Rd b/man/add_figure_details.Rd new file mode 100644 index 0000000..fa7c397 --- /dev/null +++ b/man/add_figure_details.Rd @@ -0,0 +1,50 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/g_pkconc_ind.R +\name{add_figure_details} +\alias{add_figure_details} +\title{Add Figure Details to Data Frame} +\usage{ +add_figure_details( + adpc, + title = "", + collapse_subtitle = "\\n", + studyid = NULL, + trt_var, + plotgroup_vars, + plotgroup_names, + xvar_unit, + xmin = NA, + xmax = NA, + footnote = NULL +) +} +\arguments{ +\item{adpc}{A data frame containing the data.} + +\item{title}{A character string specifying the title for the plot.} + +\item{studyid}{A character string specifying the study ID variable.} + +\item{trt_var}{A character string specifying the treatment variable.} + +\item{plotgroup_vars}{A character vector of the grouping data variables.} + +\item{plotgroup_names}{A character vector for the grouping variables names.} + +\item{xvar_unit}{A character string for the unit for the x-axis variable.} + +\item{xmin}{A numeric value specifying the minimum x-axis limit.} + +\item{xmax}{A numeric value specifying the maximum x-axis limit.} + +\item{footnote}{A character string specifying plot's manual footnote.} +} +\value{ +A data frame with added figure details. +} +\description{ +This function adds figure details; title, subtitle, and caption to the data. +} +\author{ +Gerardo Rodriguez +} diff --git a/man/filter_breaks.Rd b/man/filter_breaks.Rd index 3514856..3bb7930 100644 --- a/man/filter_breaks.Rd +++ b/man/filter_breaks.Rd @@ -1,22 +1,28 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/filter_breaks.R +% Please edit documentation in R/filter_breaks.R, R/g_pkconc_ind.R \name{filter_breaks} \alias{filter_breaks} \title{Filter Breaks for X-Axis} \usage{ -filter_breaks(breaks = NA, plot = plot, min_cm_distance = 0.5, axis = "x") +filter_breaks(x_breaks = NA, plot = plot, min_cm_distance = 0.5) + +filter_breaks(x_breaks = NA, plot = plot, min_cm_distance = 0.5) } \arguments{ +\item{x_breaks}{A numeric vector of x-axis breaks.} + \item{plot}{A ggplot object used to extract plot dimensions and scales.} \item{min_cm_distance}{A numeric of the minimum distance between breaks.} - -\item{x_breaks}{A numeric vector of x-axis breaks.} } \value{ +A numeric vector of filtered x-axis breaks. + A numeric vector of filtered x-axis breaks. } \description{ +Filters X-axis for consecutive breaks with at least the specified distance. + Filters X-axis for consecutive breaks with at least the specified distance. } \author{ diff --git a/man/g_pkconc_ind_lin.Rd b/man/g_pkconc_ind_lin.Rd new file mode 100644 index 0000000..bc065e9 --- /dev/null +++ b/man/g_pkconc_ind_lin.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/g_pkconc_ind.R +\name{g_pkconc_ind_lin} +\alias{g_pkconc_ind_lin} +\title{Wrapper around aNCA::pkcg01() function. Calls the function with \code{LIN} scale argument.} +\usage{ +g_pkconc_ind_lin(data, ...) +} +\arguments{ +\item{data}{Data to be passed into the plotting function.} + +\item{...}{Any other parameters to be passed into the ploting function.} +} +\value{ +ggplot2 object for pckg01. +} +\description{ +Wrapper around aNCA::pkcg01() function. Calls the function with \code{LIN} scale argument. +} diff --git a/man/g_pkconc_ind_log.Rd b/man/g_pkconc_ind_log.Rd new file mode 100644 index 0000000..4e3aecb --- /dev/null +++ b/man/g_pkconc_ind_log.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/g_pkconc_ind.R +\name{g_pkconc_ind_log} +\alias{g_pkconc_ind_log} +\title{Wrapper around aNCA::pkcg01() function. Calls the function with \code{LOG} scale argument.} +\usage{ +g_pkconc_ind_log(data, ...) +} +\arguments{ +\item{data}{Data to be passed into the plotting function.} + +\item{...}{Any other parameters to be passed into the ploting function.} +} +\value{ +ggplot2 object for pckg01. +} +\description{ +Wrapper around aNCA::pkcg01() function. Calls the function with \code{LOG} scale argument. +} diff --git a/man/pkcg01.Rd b/man/pkcg01.Rd new file mode 100644 index 0000000..7987d25 --- /dev/null +++ b/man/pkcg01.Rd @@ -0,0 +1,98 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/g_pkconc_ind.R +\name{pkcg01} +\alias{pkcg01} +\title{Generate PK Concentration-Time Profile Plots} +\usage{ +pkcg01( + adpc = data(), + xvar = "AFRLT", + yvar = "AVAL", + xvar_unit = "RRLTU", + yvar_unit = "AVALU", + color_var = NULL, + color_var_label = NULL, + xbreaks_var = "NFRLT", + xbreaks_mindist = 0.5, + xmin = NA, + xmax = NA, + ymin = NA, + ymax = NA, + xlab = paste0(xvar, " [", unique(adpc[[xvar_unit]]), "]"), + ylab = paste0(yvar, " [", unique(adpc[[yvar_unit]]), "]"), + footnote = NULL, + plotgroup_vars = c("ROUTE", "PCSPEC", "PARAM", "USUBJID"), + plotgroup_names = c("Route", "Specimen", "Analyte", "Subject ID"), + scale = c("LIN", "LOG", "SBS")[1], + studyid = "STUDYID", + trt_var = "TRT01A" +) +} +\arguments{ +\item{adpc}{A data frame containing the data.} + +\item{xvar}{A character string of the variable name for the x-axis.} + +\item{yvar}{A character string of the variable name for the y-axis.} + +\item{xvar_unit}{A character string of the unit for the x-axis variable.} + +\item{yvar_unit}{A character string of the unit for the y-axis variable.} + +\item{color_var}{A character string of the variable name for the color.} + +\item{color_var_label}{A character string of the color label.} + +\item{xbreaks_var}{A character string of the x-axis breaks.} + +\item{xmin}{A numeric value specifying the minimum x-axis limit.} + +\item{xmax}{A numeric value specifying the maximum x-axis limit.} + +\item{ymin}{A numeric value for the minimum y-axis limit.} + +\item{ymax}{A numeric value for the maximum y-axis limit.} + +\item{xlab}{Character for x-axis label. Defaults: \code{xvar} label & \code{xvar_unit}.} + +\item{ylab}{Character for y-axis label. Defaults: \code{yvar} label & \code{yvar_unit}.} + +\item{footnote}{A character string of a manual footnote for the plot.} + +\item{plotgroup_vars}{A character vector of the variables to group data.} + +\item{plotgroup_names}{A character vector of the grouping variable names.} + +\item{studyid}{A character string specifying the study ID variable.} + +\item{trt_var}{A character string specifying the treatment variable.} + +\item{options}{A list of additional options (e.g., display scale).} +} +\value{ +A list of ggplot objects for each unique group. +} +\description{ +This function generates a list of ggplots for PK concentration-time profiles. +} +\examples{ +\dontrun { + adpc <- read.csv("inst/shiny/data/DummyRO_ADNCA.csv") + attr(adpc[["AFRLT"]], "label") <- "Actual time from first dose" + attr(adpc[["AVAL"]], "label") <- "Analysis val + + plots_lin <- pkcg01(adpc = adpc, xmax = 1) + plots_log <- pkcg01(adpc = adpc, color_var = "USUBJID", scale = "LOG) + plots_sbs <- pkcg01( + adpc = adpc, + color_var = "USUBJID", + xbreaks_var = "NFRLT", + xmin = 100, xmax = 1000, + scale = "SBS" + ) +} + +} +\author{ +Gerardo Rodriguez +} From 785d459aa0b8fb2b9daf7126dcf759b6f1d9ef50 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 12 Dec 2024 09:50:19 +0100 Subject: [PATCH 19/93] feat: implemented keyword for selecting choices from data column --- inst/shiny/modules/tlg_plot.R | 10 +++++++++- inst/shiny/tlg.yaml | 1 + 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R index c43b61d..75d1906 100644 --- a/inst/shiny/modules/tlg_plot.R +++ b/inst/shiny/modules/tlg_plot.R @@ -98,7 +98,15 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { ) }, select = { - choices <- if (isTRUE(opt_def$choices == ".colnames")) names(data()) else opt_def$choices + choices <- { + if (isTRUE(opt_def$choices == ".colnames")) { + names(data()) + } else if (length(opt_def$choices) == 1 && grepl("^\\.", opt_def$choices)) { + unique(data()[, sub("^\\.", "", opt_def$choices)]) + } else { + opt_def$choices + } + } selectInput( session$ns(opt_id), label = label, diff --git a/inst/shiny/tlg.yaml b/inst/shiny/tlg.yaml index 06612ab..7e54652 100644 --- a/inst/shiny/tlg.yaml +++ b/inst/shiny/tlg.yaml @@ -18,6 +18,7 @@ # choices: # applicable to 'select' type, choices to pick from the dropdown, either specified # # outright or using a special keyword: # - .colnames keyword will pull the choices from the data column names + # - .COLUMN_NAME keyword will pull choices from values of a specific column g_pkconc_ind_lin: is_default: true type: Graph From 9fd3c3a5d9e331e68ebcd1657872528affbbbb98 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 12 Dec 2024 10:02:17 +0100 Subject: [PATCH 20/93] feat: added ability to specify defaults --- inst/shiny/modules/tlg_plot.R | 19 ++++++++++++++++--- inst/shiny/tlg.yaml | 5 +++++ 2 files changed, 21 insertions(+), 3 deletions(-) diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R index 75d1906..3908dcc 100644 --- a/inst/shiny/modules/tlg_plot.R +++ b/inst/shiny/modules/tlg_plot.R @@ -87,14 +87,14 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { textInput( session$ns(opt_id), label = label, - value = "" + value = opt_def$default ) }, numeric = { numericInput( session$ns(opt_id), label = label, - value = 0 + value = opt_def$default ) }, select = { @@ -107,10 +107,23 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { opt_def$choices } } + + selected <- { + if (!is.null(opt_def$default)) { + if (opt_def$default == ".all") { + choices + } else { + opt_def$default + } + } else { + "" + } + } + selectInput( session$ns(opt_id), label = label, - selected = "", + selected = selected, choices = c("", choices), multiple = isTRUE(opt_def$multiple) ) diff --git a/inst/shiny/tlg.yaml b/inst/shiny/tlg.yaml index 7e54652..25acd3b 100644 --- a/inst/shiny/tlg.yaml +++ b/inst/shiny/tlg.yaml @@ -14,6 +14,9 @@ # optname: # option name, the same as the argument that is passed to the rendering function # type: # type of the option/widget, one of: text, numeric, select # label: # label to be displayed in the editing widget +# default: # default value to be provided in the field; if provided, will overwrite function +# # argument defaults. if left empty, function defaults will be applied; if type is selected, +# # '.all' keyword can be applied to select all choices # multiple: # applicable to 'select' type, whether to allow for multiple values to be selected # choices: # applicable to 'select' type, choices to pick from the dropdown, either specified # # outright or using a special keyword: @@ -40,6 +43,7 @@ g_pkconc_ind_lin: plotgroup_vars: type: select label: "Grouping variables" + default: .all multiple: true choices: - ROUTE @@ -52,6 +56,7 @@ g_pkconc_ind_lin: xlab: type: text label: X axis label + default: "Test default label" ylab: type: text label: Y axis label From cfda424d5aa5e80585ffe30787d18d477ef3e130 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 12 Dec 2024 10:04:52 +0100 Subject: [PATCH 21/93] docs: added comments, fixed spelling --- R/g_pkconc_ind.R | 8 ++++---- inst/WORDLIST | 2 ++ inst/shiny/modules/tlg_plot.R | 7 ++++++- man/g_pkconc_ind_lin.Rd | 4 ++-- man/g_pkconc_ind_log.Rd | 4 ++-- 5 files changed, 16 insertions(+), 9 deletions(-) diff --git a/R/g_pkconc_ind.R b/R/g_pkconc_ind.R index c25b31e..eee2b8d 100644 --- a/R/g_pkconc_ind.R +++ b/R/g_pkconc_ind.R @@ -1,7 +1,7 @@ #' Wrapper around aNCA::pkcg01() function. Calls the function with `LIN` scale argument. #' @param data Data to be passed into the plotting function. -#' @param ... Any other parameters to be passed into the ploting function. -#' @returns ggplot2 object for pckg01. +#' @param ... Any other parameters to be passed into the plotting function. +#' @returns ggplot2 object for pkcg01. #' @export g_pkconc_ind_lin <- function(data, ...) { pkcg01(adpc = data, scale = "LIN", ...) @@ -9,8 +9,8 @@ g_pkconc_ind_lin <- function(data, ...) { #' Wrapper around aNCA::pkcg01() function. Calls the function with `LOG` scale argument. #' @param data Data to be passed into the plotting function. -#' @param ... Any other parameters to be passed into the ploting function. -#' @returns ggplot2 object for pckg01. +#' @param ... Any other parameters to be passed into the plotting function. +#' @returns ggplot2 object for pkcg01. #' @export g_pkconc_ind_log <- function(data, ...) { pkcg01(adpc = data, scale = "LOG") diff --git a/inst/WORDLIST b/inst/WORDLIST index bf93fcc..fe2e4e1 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -27,8 +27,10 @@ anonymizes cmax csv ggplot +ggplots nca pharmacokinetic +pkcg pknca plotly pptest diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R index 3908dcc..4b4ed83 100644 --- a/inst/shiny/modules/tlg_plot.R +++ b/inst/shiny/modules/tlg_plot.R @@ -38,6 +38,7 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { observeEvent(input$previous_page, current_page(current_page() - 1)) observeEvent(input$select_page, current_page(as.numeric(input$select_page))) + #' when data is provided, set page to 1 and render appropriate UI observeEvent(data(), { current_page(1) output$page_number <- renderUI(length(plot_list())) @@ -51,13 +52,14 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { }) }) + #' updates UI responsible for page change observeEvent(current_page(), { shinyjs::toggleState(id = "previous_page", condition = current_page() > 1) shinyjs::toggleState(id = "next_page", condition = current_page() < length(plot_list())) updateSelectInput(session = session, inputId = "select_page", selected = current_page()) }) - + #' keeps list of plots to render, with options gathered from the UI and applied plot_list <- reactive({ plot_options <- purrr::list_modify(list(data = data()), !!!reactiveValuesToList(options_)) @@ -73,7 +75,10 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { plot_list()[[current_page()]] }) + #' holds options gathered from UI widgets options_ <- reactiveValues() + + #' creates widgets responsible for custimizing the plots option_widgets <- purrr::imap(options, function(opt_def, opt_id) { observeEvent(input[[opt_id]], { options_[[opt_id]] <- input[[opt_id]] diff --git a/man/g_pkconc_ind_lin.Rd b/man/g_pkconc_ind_lin.Rd index bc065e9..08e4817 100644 --- a/man/g_pkconc_ind_lin.Rd +++ b/man/g_pkconc_ind_lin.Rd @@ -9,10 +9,10 @@ g_pkconc_ind_lin(data, ...) \arguments{ \item{data}{Data to be passed into the plotting function.} -\item{...}{Any other parameters to be passed into the ploting function.} +\item{...}{Any other parameters to be passed into the plotting function.} } \value{ -ggplot2 object for pckg01. +ggplot2 object for pkcg01. } \description{ Wrapper around aNCA::pkcg01() function. Calls the function with \code{LIN} scale argument. diff --git a/man/g_pkconc_ind_log.Rd b/man/g_pkconc_ind_log.Rd index 4e3aecb..98dfdfd 100644 --- a/man/g_pkconc_ind_log.Rd +++ b/man/g_pkconc_ind_log.Rd @@ -9,10 +9,10 @@ g_pkconc_ind_log(data, ...) \arguments{ \item{data}{Data to be passed into the plotting function.} -\item{...}{Any other parameters to be passed into the ploting function.} +\item{...}{Any other parameters to be passed into the plotting function.} } \value{ -ggplot2 object for pckg01. +ggplot2 object for pkcg01. } \description{ Wrapper around aNCA::pkcg01() function. Calls the function with \code{LOG} scale argument. From 0f9700da55c381d3490c45c9b75c7ef8f1b12824 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 12 Dec 2024 10:20:59 +0100 Subject: [PATCH 22/93] feat: added ability to provide grouping labels for the widgets --- inst/shiny/modules/tlg_plot.R | 4 ++++ inst/shiny/tlg.yaml | 6 ++++++ inst/shiny/www/style.css | 10 +++++++++- 3 files changed, 19 insertions(+), 1 deletion(-) diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R index 4b4ed83..9f39f67 100644 --- a/inst/shiny/modules/tlg_plot.R +++ b/inst/shiny/modules/tlg_plot.R @@ -80,6 +80,10 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { #' creates widgets responsible for custimizing the plots option_widgets <- purrr::imap(options, function(opt_def, opt_id) { + if (grepl(".group_label", opt_id)) { + return(tags$h1(opt_def, class = "tlg-group-label")) + } + observeEvent(input[[opt_id]], { options_[[opt_id]] <- input[[opt_id]] }) diff --git a/inst/shiny/tlg.yaml b/inst/shiny/tlg.yaml index 25acd3b..0ec7686 100644 --- a/inst/shiny/tlg.yaml +++ b/inst/shiny/tlg.yaml @@ -22,6 +22,9 @@ # # outright or using a special keyword: # - .colnames keyword will pull the choices from the data column names # - .COLUMN_NAME keyword will pull choices from values of a specific column +# There are additional keywords to allow shaping the resulting interface: +# .group_label_N: # will create a label to help visually group related widgets; should be a character +# # string; N should be replaced with an integer to uniquely identify the keyword g_pkconc_ind_lin: is_default: true type: Graph @@ -32,6 +35,7 @@ g_pkconc_ind_lin: link: https://insightsengineering.github.io/tlg-catalog/stable/graphs/pharmacokinetic/pkcg01.html fun: g_pkconc_ind_lin options: + .group_label_1: "General" xvar: type: select label: X axis @@ -50,6 +54,7 @@ g_pkconc_ind_lin: - PCSPEC - PARAM - USUBJID + .group_label_2: "Labels" footnote: type: text label: Footnote @@ -60,6 +65,7 @@ g_pkconc_ind_lin: ylab: type: text label: Y axis label + .group_label_3: "Limits" xmin: type: numeric xmax: diff --git a/inst/shiny/www/style.css b/inst/shiny/www/style.css index d04a0ce..e16d561 100644 --- a/inst/shiny/www/style.css +++ b/inst/shiny/www/style.css @@ -149,4 +149,12 @@ justify-content: space-around; align-items: baseline; margin-bottom: 1em; - } \ No newline at end of file + } + + /* tlg tab */ + h1.tlg-group-label { + font-weight: bold; + font-size: 3rem; + border-bottom: thin solid #337ab7; + border-radius: 0 0 .25em 0; +} \ No newline at end of file From 49793d5a5f5afbf13f61392189390ede3e64d14e Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 12 Dec 2024 10:28:10 +0100 Subject: [PATCH 23/93] chore: added missing deps --- DESCRIPTION | 2 ++ 1 file changed, 2 insertions(+) diff --git a/DESCRIPTION b/DESCRIPTION index 00ecf66..887999e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -31,6 +31,7 @@ Imports: dplyr, DT, forcats, + ggh4x, ggplot2, haven, htmlwidgets, @@ -42,6 +43,7 @@ Imports: reactable.extras, rio, rmarkdown, + scales, shiny, shinyBS, shinyFiles, From 3826e491254dd25d58601719ac8584e2b2231fa3 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Fri, 13 Dec 2024 09:01:54 +0100 Subject: [PATCH 24/93] feat: added ability to specify number of plots per page --- inst/shiny/modules/tlg_plot.R | 178 +++++++++++++++++++++------------- 1 file changed, 110 insertions(+), 68 deletions(-) diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R index 9f39f67..1b6a760 100644 --- a/inst/shiny/modules/tlg_plot.R +++ b/inst/shiny/modules/tlg_plot.R @@ -9,18 +9,33 @@ tlg_plot_ui <- function(id) { div(align = "left", shinyjs::disabled(actionButton(ns("previous_page"), "Previous Page"))), div( align = "center", + tags$span( + class = "inline-select-input", + style = "margin-right: 1em;", + tags$span("Plots per page:"), + selectInput( + ns("plots_per_page"), + "", + choices = c(1, 2, 4, 6, 8, 10, "All"), + selected = 1 + ) + ), tags$span( class = "inline-select-input", tags$span("Page "), - uiOutput(ns("select_page_ui")), + selectInput( + inputId = ns("select_page"), + label = "", + choices = "" + ), tags$span(" out of "), - uiOutput(ns("page_number"), inline = TRUE) + uiOutput(ns("page_number"), inline = TRUE), ) ), div(align = "right", actionButton(ns("next_page"), "Next Page")) ), # Plots display # - plotlyOutput(ns("plot")) + uiOutput(ns("plots")) ), column( width = 3, @@ -38,26 +53,38 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { observeEvent(input$previous_page, current_page(current_page() - 1)) observeEvent(input$select_page, current_page(as.numeric(input$select_page))) - #' when data is provided, set page to 1 and render appropriate UI - observeEvent(data(), { - current_page(1) - output$page_number <- renderUI(length(plot_list())) - output$select_page_ui <- renderUI({ - selectInput( - inputId = session$ns("select_page"), - label = "", - choices = seq_len(length(plot_list())), - selected = 1 - ) - }) + #' hold reactive information about the page layout + num_pages <- reactive({ + req(plot_list(), plots_per_page()) + ceiling(length(plot_list()) / plots_per_page()) + }) + + plots_per_page <- reactive({ + if (is.null(input$plots_per_page)) return(NULL) + if (input$plots_per_page == "All") { + isolate(length(plot_list())) + } else { + as.numeric(input$plots_per_page) + } }) #' updates UI responsible for page change - observeEvent(current_page(), { + observeEvent(list(current_page(), num_pages()), { + req(num_pages(), current_page()) shinyjs::toggleState(id = "previous_page", condition = current_page() > 1) - shinyjs::toggleState(id = "next_page", condition = current_page() < length(plot_list())) + shinyjs::toggleState( + id = "next_page", + condition = num_pages() != 1 && current_page() < num_pages() + ) updateSelectInput(session = session, inputId = "select_page", selected = current_page()) }) + observeEvent(plots_per_page(), { + req(num_pages(), plots_per_page()) + current_page(1) + + output$page_number <- renderUI(paste0(num_pages(), ".")) + updateSelectInput(inputId = "select_page", choices = seq_len(num_pages())) + }) #' keeps list of plots to render, with options gathered from the UI and applied plot_list <- reactive({ @@ -71,8 +98,14 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { do.call(render_plot, plot_options) }) - output$plot <- renderPlotly({ - plot_list()[[current_page()]] + output$plots <- renderUI({ + req(plot_list(), plots_per_page(), current_page()) + num_plots <- length(plot_list()) + page_end <- current_page() * plots_per_page() + page_start <- page_end - plots_per_page() + 1 + if (page_end > num_plots) page_end <- num_plots + + plot_list()[page_start:page_end] }) #' holds options gathered from UI widgets @@ -88,58 +121,67 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { options_[[opt_id]] <- input[[opt_id]] }) - label <- if (is.null(opt_def$label)) opt_id else opt_def$label + create_edit_widget(opt_def, opt_id) + }) - switch( - opt_def$type, - text = { - textInput( - session$ns(opt_id), - label = label, - value = opt_def$default - ) - }, - numeric = { - numericInput( - session$ns(opt_id), - label = label, - value = opt_def$default - ) - }, - select = { - choices <- { - if (isTRUE(opt_def$choices == ".colnames")) { - names(data()) - } else if (length(opt_def$choices) == 1 && grepl("^\\.", opt_def$choices)) { - unique(data()[, sub("^\\.", "", opt_def$choices)]) - } else { - opt_def$choices - } - } + output$options <- renderUI(option_widgets) + }) +} - selected <- { - if (!is.null(opt_def$default)) { - if (opt_def$default == ".all") { - choices - } else { - opt_def$default - } - } else { - "" - } - } +#' Creates editing widget of appropriate type. +#' @param opt_def Definition of the option +#' @param opt_id Id of the option +#' @param session Session object for namespacing the widgets +#' @returns Shiny widget with appropriate type, label and options +create_edit_widget <- function(opt_def, opt_id, session = shiny::getDefaultReactiveDomain()) { + label <- if (is.null(opt_def$label)) opt_id else opt_def$label + + switch( + opt_def$type, + text = { + textInput( + session$ns(opt_id), + label = label, + value = opt_def$default + ) + }, + numeric = { + numericInput( + session$ns(opt_id), + label = label, + value = opt_def$default + ) + }, + select = { + choices <- { + if (isTRUE(opt_def$choices == ".colnames")) { + names(data()) + } else if (length(opt_def$choices) == 1 && grepl("^\\.", opt_def$choices)) { + unique(data()[, sub("^\\.", "", opt_def$choices)]) + } else { + opt_def$choices + } + } - selectInput( - session$ns(opt_id), - label = label, - selected = selected, - choices = c("", choices), - multiple = isTRUE(opt_def$multiple) - ) + selected <- { + if (!is.null(opt_def$default)) { + if (opt_def$default == ".all") { + choices + } else { + opt_def$default + } + } else { + "" } - ) - }) + } - output$options <- renderUI(option_widgets) - }) + selectInput( + session$ns(opt_id), + label = label, + selected = selected, + choices = c("", choices), + multiple = isTRUE(opt_def$multiple) + ) + } + ) } \ No newline at end of file From 85061819c5abb3f9de048ea28a519bf9413a1a57 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Fri, 15 Nov 2024 13:52:54 +0100 Subject: [PATCH 25/93] feat, wip: simple DEMO of tlg implementation --- NAMESPACE | 3 ++ R/g_pkconc_ind.R | 30 ++++++++++++ inst/shiny/global.R | 2 + inst/shiny/modules/tab_tlg.R | 89 +++++++++++++++++++---------------- inst/shiny/modules/tlg_plot.R | 37 +++++++++++++++ inst/shiny/tlg.yaml | 40 ++++++++++++++++ 6 files changed, 161 insertions(+), 40 deletions(-) create mode 100644 R/g_pkconc_ind.R create mode 100644 inst/shiny/modules/tlg_plot.R create mode 100644 inst/shiny/tlg.yaml diff --git a/NAMESPACE b/NAMESPACE index 761a6e3..a4b7fd3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -9,6 +9,9 @@ export(create_dose) export(filter_breaks) export(flexible_violinboxplot) export(format_data) +export(g_pkconc_ind) +export(g_pkconc_ind_lin) +export(g_pkconc_ind_log) export(general_lineplot) export(general_meanplot) export(geometric_mean) diff --git a/R/g_pkconc_ind.R b/R/g_pkconc_ind.R new file mode 100644 index 0000000..67df024 --- /dev/null +++ b/R/g_pkconc_ind.R @@ -0,0 +1,30 @@ +#' TODO: Implement actual pkconc plot +#' @export +g_pkconc_ind <- function(data, scale = "lin", xlab = "test x lab", ylab = "test y lab") { + p <- ggplot2::ggplot( + data = data, + mapping = aes(x = TIME, y = ADOSEDUR) + ) + + ggplot2::geom_point() + + ggplot2::labs( + x = xlab, + y = ylab + ) + + if (scale == "log") { + p <- p + + ggplot2::scale_y_log10() + } + + p +} + +#' @export +g_pkconc_ind_lin <- function(data, ...) { + g_pkconc_ind(data = data, scale = "lin", ...) +} + +#' @export +g_pkconc_ind_log <- function(data, ...) { + g_pkconc_ind(data, scale = "log", ...) +} \ No newline at end of file diff --git a/inst/shiny/global.R b/inst/shiny/global.R index 1458ee7..b72c57d 100644 --- a/inst/shiny/global.R +++ b/inst/shiny/global.R @@ -3,3 +3,5 @@ source("modules/tab_data.R") source("modules/slope_selector.R") source("functions/partial_auc_input.R") + +source("modules/tlg_plot.R") diff --git a/inst/shiny/modules/tab_tlg.R b/inst/shiny/modules/tab_tlg.R index bdbf220..190f2cb 100644 --- a/inst/shiny/modules/tab_tlg.R +++ b/inst/shiny/modules/tab_tlg.R @@ -1,3 +1,5 @@ +.TLG_DEFINITIONS <- yaml::read_yaml(system.file("shiny/tlg.yaml", package = "aNCA")) + tab_tlg_ui <- function(id) { ns <- NS(id) @@ -56,29 +58,7 @@ tab_tlg_ui <- function(id) { ) ) ), - tabPanel( - "Graphs", - fluidRow( - column( - 2, # Left column for plot selection - radioButtons( - inputId = ns("buttons_Graphs"), - label = "Choose Graph\n", - choices = "" - ) - ), - column( - 6, # Middle column for plot output - h4("Graph to display"), - plotOutput(ns("plot_Graphs")) - ), - column( - 2, # Right column for plot customization inputs - h4("Inputs with selected vals linked to downloadable obj (i.e, tlg_order())"), - textInput(ns("footnote_Graphs"), label = "Footnote") - ) - ) - ) + tabPanel("Graphs", uiOutput(ns("graphs"))) ) } @@ -87,10 +67,33 @@ tab_tlg_server <- function(id, data) { ns <- session$ns # Make available the CSV file with the TLG list and available links to NEST - tlg_order <- reactiveVal( - read.csv(system.file("www/data/TLG_order_details.csv", package = "aNCA")) %>% - mutate(PKid = paste0("", PKid, "")) - ) + tlg_order <- reactiveVal({ + tlg_data <- dplyr::tibble( + id = character(), + Selection = logical(), + Type = character(), + Dataset = character(), + PKid = character(), + Description = character(), + Footnote = character(), + Stratification = character(), + Condition = character(), + Comment = character() + ) + + purrr::iwalk(.TLG_DEFINITIONS, function(x, id) { + tlg_data <<- dplyr::add_row( + tlg_data, + id = id, + Selection = x$is_default, + Type = x$type, + Dataset = x$dataset, + PKid = paste0("", x$pkid, ""), + Description = x$description + ) + }) + tlg_data + }) # Based on the TLG list conditions for data() define the preselected rows in $Selection observeEvent(list(tlg_order(), data()), { @@ -267,19 +270,25 @@ tab_tlg_server <- function(id, data) { choices = "") } - if (sum(tlg_order_filt$Type == "Graph") > 0) { - updateRadioButtons( - session = session, - inputId = "buttons_Graphs", - label = "Graph to display", - choices = tlg_order_filt$Label[tlg_order_filt$Type == "Graph"] - ) - } else { - updateRadioButtons(session = session, - inputId = "buttons_Graphs", - label = "", - choices = "") - } + tlg_order_graphs <- filter(tlg_order_filt, Type == "Graph")$id + panels <- lapply(tlg_order_graphs, function(g_id) { + plot_ui <- { + g_def <- .TLG_DEFINITIONS[[g_id]] + + if (exists(g_def$fun)) { + tlg_plot_server(g_id, get(g_def$fun), g_def$opts, data) + tlg_plot_ui(session$ns(g_id)) + } else { + tags$div("Plot not implemented yet") + } + } + + tabPanel(g_def$label, plot_ui) + }) + + output$graphs <- renderUI({ + do.call(navlistPanel, panels) + }) }) }) } diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R new file mode 100644 index 0000000..ae85b7d --- /dev/null +++ b/inst/shiny/modules/tlg_plot.R @@ -0,0 +1,37 @@ +tlg_plot_ui <- function(id) { + ns <- NS(id) + + fluidRow( + column( + width = 9, + plotOutput(ns("plot")) + ), + column( + width = 3, + uiOutput(ns("options")) + ) + ) +} + +tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { + moduleServer(id, function(input, output, session) { + output$plot <- renderPlot({ + do.call(render_plot, purrr::list_modify(list(data = data()), !!!reactiveValuesToList(opts))) + }) + + opts <- reactiveValues() + + option_widgets <- lapply(options, function(opt_id) { + observeEvent(input[[opt_id]], { + opts[[opt_id]] <- input[[opt_id]] + }) + + textInput( + session$ns(opt_id), + label = opt_id + ) + }) + + output$options <- renderUI(option_widgets) + }) +} \ No newline at end of file diff --git a/inst/shiny/tlg.yaml b/inst/shiny/tlg.yaml new file mode 100644 index 0000000..e8e4a86 --- /dev/null +++ b/inst/shiny/tlg.yaml @@ -0,0 +1,40 @@ +# Configuration file containing TLG definitions. Each TLG should be a separate entry, with unique ID. +# The TLG entry should have the following format: +# id: +# is_default: # true / false whether TLG should be included as default +# type: # Graph / List / Table +# dataset: # name of the dataset +# pkid: # standarized id of the TLG +# label: # short label to display as tab name +# description: # longer descriptions, to be displayed in the order table +# link: # link to the documentation of the TLG +# fun: # name of the function exported by the package, responsible for generating TLG +# opts: # options that can be passed as arguments to the function +# - option1 # will generate input widgets for editing +# - option2 # TODO: add ability to specify default value and type + +g_pkconc_ind_lin: + is_default: true + type: Graph + dataset: ADPC + pkid: pkcg01 + label: pkcg01 - linear + description: "Individual plots of concentrations vs. time (one plot per patient/subject) with linear scale" + link: https://insightsengineering.github.io/tlg-catalog/stable/graphs/pharmacokinetic/pkcg01.html + fun: g_pkconc_ind_lin + opts: + - xlab + - ylab +g_pkconc_ind_log: + is_default: true + type: Graph + dataset: ADPC + pkid: pkcg01 + label: pkcg01 - log + description: "Individual plots of concentrations vs. time (one plot per patient/subject) with log10 scale" + link: https://insightsengineering.github.io/tlg-catalog/stable/graphs/pharmacokinetic/pkcg01.html + fun: g_pkconc_ind_log + opts: + - xlab + - ylab + \ No newline at end of file From 235f30ffd929aca450a787b60b9dc6022dded040 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 21 Nov 2024 08:53:06 +0100 Subject: [PATCH 26/93] feat: tlg_plot cleans up user input, adjusted to functions returning plot lists --- inst/shiny/modules/tlg_plot.R | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R index ae85b7d..6412f61 100644 --- a/inst/shiny/modules/tlg_plot.R +++ b/inst/shiny/modules/tlg_plot.R @@ -15,8 +15,19 @@ tlg_plot_ui <- function(id) { tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { moduleServer(id, function(input, output, session) { + plot_list <- reactive({ + plot_options <- purrr::list_modify(list(data = data()), !!!reactiveValuesToList(opts)) + + purrr::iwalk(plot_options, \(value, name) { + if (isTRUE(value == "")) + plot_options[[name]] <<- NULL + }) + + do.call(render_plot, plot_options) + }) + output$plot <- renderPlot({ - do.call(render_plot, purrr::list_modify(list(data = data()), !!!reactiveValuesToList(opts))) + plot_list()[[1]] }) opts <- reactiveValues() From 9369ab0c88da15a337d782f0ad5951cb5d9f5110 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 28 Nov 2024 08:18:57 +0100 Subject: [PATCH 27/93] feat: working page selection --- inst/shiny/modules/tlg_plot.R | 45 ++++++++++++++++++++++++++++++++++- inst/shiny/www/style.css | 14 +++++++++++ 2 files changed, 58 insertions(+), 1 deletion(-) diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R index 6412f61..663aef3 100644 --- a/inst/shiny/modules/tlg_plot.R +++ b/inst/shiny/modules/tlg_plot.R @@ -4,6 +4,22 @@ tlg_plot_ui <- function(id) { fluidRow( column( width = 9, + fluidRow( + class = "plot-widgets-container", + div(align = "left", shinyjs::disabled(actionButton(ns("previous_page"), "Previous Page"))), + div( + align = "center", + tags$span( + class = "inline-select-input", + tags$span("Page "), + uiOutput(ns("select_page_ui")), + tags$span(" out of "), + uiOutput(ns("page_number"), inline = TRUE) + ) + ), + div(align = "right", actionButton(ns("next_page"), "Next Page")) + ), + # Plots display # plotOutput(ns("plot")) ), column( @@ -15,6 +31,33 @@ tlg_plot_ui <- function(id) { tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { moduleServer(id, function(input, output, session) { + current_page <- reactiveVal(1) + + #' updating current page based on user input + observeEvent(input$next_page, current_page(current_page() + 1)) + observeEvent(input$previous_page, current_page(current_page() - 1)) + observeEvent(input$select_page, current_page(as.numeric(input$select_page))) + + observeEvent(data(), { + current_page(1) + output$page_number <- renderUI(length(plot_list())) + output$select_page_ui <- renderUI({ + selectInput( + inputId = session$ns("select_page"), + label = "", + choices = seq_len(length(plot_list())), + selected = 1 + ) + }) + }) + + observeEvent(current_page(), { + shinyjs::toggleState(id = "previous_page", condition = current_page() > 1) + shinyjs::toggleState(id = "next_page", condition = current_page() < length(plot_list())) + updateSelectInput(session = session, inputId = "select_page", selected = current_page()) + }) + + plot_list <- reactive({ plot_options <- purrr::list_modify(list(data = data()), !!!reactiveValuesToList(opts)) @@ -27,7 +70,7 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { }) output$plot <- renderPlot({ - plot_list()[[1]] + plot_list()[[current_page()]] }) opts <- reactiveValues() diff --git a/inst/shiny/www/style.css b/inst/shiny/www/style.css index fde4db9..d04a0ce 100644 --- a/inst/shiny/www/style.css +++ b/inst/shiny/www/style.css @@ -136,3 +136,17 @@ top: 3px; } } + +.inline-select-input > div, +.inline-select-input > div > div { + width: 5em !important; + text-align: left !important; + display: inline-block !important; +} + +.plot-widgets-container { + display: flex; + justify-content: space-around; + align-items: baseline; + margin-bottom: 1em; + } \ No newline at end of file From 4f3217697f0a663a7d2429f04f45f71b1c01da32 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 28 Nov 2024 08:42:41 +0100 Subject: [PATCH 28/93] feat, wip: basic implementation of pckg01 plot --- R/g_pkconc_ind.R | 362 +++++++++++++++++++++++++++++++++++++++++--- inst/shiny/tlg.yaml | 13 +- 2 files changed, 353 insertions(+), 22 deletions(-) diff --git a/R/g_pkconc_ind.R b/R/g_pkconc_ind.R index 67df024..963cfc3 100644 --- a/R/g_pkconc_ind.R +++ b/R/g_pkconc_ind.R @@ -1,30 +1,352 @@ -#' TODO: Implement actual pkconc plot +#' Wrapper around aNCA::pkcg01() function. Calls the function with `LIN` scale argument. +#' @param data Data to be passed into the plotting function. +#' @param ... Any other parameters to be passed into the ploting function. +#' @returns ggplot2 object for pckg01. #' @export -g_pkconc_ind <- function(data, scale = "lin", xlab = "test x lab", ylab = "test y lab") { - p <- ggplot2::ggplot( - data = data, - mapping = aes(x = TIME, y = ADOSEDUR) - ) + - ggplot2::geom_point() + - ggplot2::labs( - x = xlab, - y = ylab +g_pkconc_ind_lin <- function(data, ...) { + pkcg01(adpc = data, scale = "LIN", ...) +} + +#' Wrapper around aNCA::pkcg01() function. Calls the function with `LOG` scale argument. +#' @param data Data to be passed into the plotting function. +#' @param ... Any other parameters to be passed into the ploting function. +#' @returns ggplot2 object for pckg01. +#' @export +g_pkconc_ind_log <- function(data, ...) { + pkcg01(adpc = data, scale = "LOG") +} + +#' Generate PK Concentration-Time Profile Plots +#' +#' This function generates a list of ggplots for PK concentration-time profiles. +#' +#' @param adpc A data frame containing the data. +#' @param xvar A character string of the variable name for the x-axis. +#' @param yvar A character string of the variable name for the y-axis. +#' @param xvar_unit A character string of the unit for the x-axis variable. +#' @param yvar_unit A character string of the unit for the y-axis variable. +#' @param color_var A character string of the variable name for the color. +#' @param color_var_label A character string of the color label. +#' @param xbreaks_var A character string of the x-axis breaks. +#' @param xmin A numeric value specifying the minimum x-axis limit. +#' @param xmax A numeric value specifying the maximum x-axis limit. +#' @param ymin A numeric value for the minimum y-axis limit. +#' @param ymax A numeric value for the maximum y-axis limit. +#' @param xlab Character for x-axis label. Defaults: `xvar` label & `xvar_unit`. +#' @param ylab Character for y-axis label. Defaults: `yvar` label & `yvar_unit`. +#' @param footnote A character string of a manual footnote for the plot. +#' @param plotgroup_vars A character vector of the variables to group data. +#' @param plotgroup_names A character vector of the grouping variable names. +#' @param options A list of additional options (e.g., display scale). +#' @param studyid A character string specifying the study ID variable. +#' @param trt_var A character string specifying the treatment variable. +#' @returns A list of ggplot objects for each unique group. +#' @importFrom dplyr mutate across rowwise ungroup group_by n +#' @importFrom ggplot2 aes scale_x_continuous labs +#' @importFrom tern g_ipp # Can be substituted by regular ggplot easily!! +#' @importFrom checkmate assert_numeric +#' @importFrom scales breaks_log label_log trans_breaks trans_formats +#' @importFrom ggh4x scale_y_facet +#' +#' @examples +#' \dontrun { +#' adpc <- read.csv("inst/shiny/data/DummyRO_ADNCA.csv") +#' attr(adpc[["AFRLT"]], "label") <- "Actual time from first dose" +#' attr(adpc[["AVAL"]], "label") <- "Analysis val +#' +#' plots_lin <- pkcg01(adpc = adpc, xmax = 1) +#' plots_log <- pkcg01(adpc = adpc, color_var = "USUBJID", scale = "LOG) +#' plots_sbs <- pkcg01( +#' adpc = adpc, +#' color_var = "USUBJID", +#' xbreaks_var = "NFRLT", +#' xmin = 100, xmax = 1000, +#' scale = "SBS" +#' ) +#' } +#' +#' @export +#' @author Gerardo Rodriguez +pkcg01 <- function( + adpc = data(), + xvar = "AFRLT", + yvar = "AVAL", + xvar_unit = "RRLTU", + yvar_unit = "AVALU", + color_var = NULL, + color_var_label = NULL, + xbreaks_var = "NFRLT", + xbreaks_mindist = 0.5, + xmin = NA, + xmax = NA, + ymin = NA, + ymax = NA, + # xlab = substitute(paste0(attr(adpc[[xvar]], "label"), + # " (", unique(adpc[[xvar_unit]]), ")")), + # ylab = substitute(paste0(attr(adpc[[yvar]], "label"), + # " (", unique(adpc[[yvar_unit]]), ")")), + xlab = paste0(xvar, " [", xvar_unit, "]"), + ylab = paste0(yvar, " [", yvar_unit, "]"), + footnote = NULL, + # Inputs to split-by/seggregate plots + plotgroup_vars = c("ROUTE", "PCSPEC", "PARAM", "USUBJID"), + plotgroup_names = c("Route", "Specimen", "Analyte", "Subject ID"), + + # Specific inputs (needs metadata specification), + scale = c("LIN", "LOG", "SBS")[1], + studyid = "STUDYID", + trt_var = "TRT01A" +) { + + xmin <- as.numeric(xmin) + xmax <- as.numeric(xmax) + ymin <- as.numeric(ymin) + ymax <- as.numeric(ymax) + + # Title for the plots based on display option + title <- paste0( + "Plot of PK Concentration-Time Profile ", + dplyr::case_when( + scale == "LIN" ~ "linear", + scale == "LOG" ~ "logarithmic", + TRUE ~ "linear and logarithmic" + ), + " scale" + ) + + # Include in data figure details: title, subtitle, footnote/caption + adpc <- add_figure_details( + adpc = adpc, + title = title, + collapse_subtitle = ", ", + studyid = studyid, # Includes cohort in title + trt_var = trt_var, # Includes treatment in subtitle + plotgroup_vars = plotgroup_vars, + plotgroup_names = plotgroup_names, + xvar_unit = xvar_unit, + xmin = as.numeric(xmin), + xmax = as.numeric(xmax), + footnote = footnote + ) + + # Construct the reference ggplot object + plot_data <- adpc %>% filter(id_plot == id_plot[1]) + + plot <- tern::g_ipp( + df = plot_data, + xvar = xvar, + yvar = yvar, + xlab = xlab, + ylab = ylab, + id_var = "subtitle", + add_baseline_hline = FALSE, + yvar_baseline = yvar, + title = unique(plot_data$title), + subtitle = unique(plot_data$subtitle), + caption = unique(plot_data$footnote), + plotting_choices = "separate_by_obs" + )[[1]] + + # Provide limits and additional potential future aesthetic customizations + plot <- plot + + aes(color = NULL) + + theme( + plot.title = element_text(family = "sans", size = 14, color = "black"), + plot.subtitle = element_text(family = "sans", size = 11, color = "black") + ) + + coord_cartesian(xlim = c(xmin, xmax), ylim = c(ymin, ymax)) + + # Ensure x breaks labels do not overlap graphically + plot <- plot + + scale_x_continuous( + guide = guide_axis(n.dodge = 1), + breaks = filter_breaks( + x_breaks = plot_data[[xbreaks_var]], + min_cm_distance = xbreaks_mindist, + plot = plot + ), + labels = \(x) ifelse(x %% 1 == 0, as.character(as.integer(x)), as.character(x)) ) - if (scale == "log") { - p <- p + - ggplot2::scale_y_log10() + # Add color when specified + if (!is.null(color_var)) { + plot <- plot + + aes(color = !!sym(color_var)) + + theme(legend.position = "none") + } + + # Add color legend only when neccessary + if (!is.null(color_var_label) && length(color_var) > 1) { + plot <- plot + + labs(color = if (!is.null(color_var_label)) color_var_label else color_var) + + theme(legend.position = "bottom") + } + + + if (scale == "LOG") { + # Create LOG version of data and plot + adpc <- adpc %>% + dplyr::mutate(across(all_of(yvar), ~ ifelse(. < 1e-3, 1e-3, .))) + + plot <- plot %+% dplyr::filter(adpc, id_plot == id_plot[1]) + + scale_y_continuous( + trans = scales::log10_trans(), + breaks = scales::trans_breaks("log10", \(x) 10^x), + labels = scales::trans_format("log10", scales::math_format(10^.x)) + ) + + annotation_logticks(sides = "l") + + labs(y = paste0("Log 10 - ", plot$labels$y)) + } + + if (scale == "SBS") { + # Create SBS version of data and plot + adpc <- rbind(adpc, adpc) %>% + dplyr::mutate( + view = c(rep("Linear view", nrow(adpc)), rep("Semilogarithmic view (Log10)", nrow(adpc))), + !!sym(yvar) := ifelse( + !!sym(yvar) < 1e-3 & view == "Semilogarithmic view (Log10)", yes = 1e-3, no = !!sym(yvar) + ) + ) + + plot <- plot %+% dplyr::filter(adpc, id_plot == unique(id_plot)[1]) + + facet_wrap(~ view, scales = "free_y") + + annotation_logticks(sides = "l", linewidth = 0.1, alpha = c(0, 1)) + + ggh4x::scale_y_facet( + view == "Semilogarithmic view (Log10)", + trans = "log10", + breaks = scales::breaks_log(), + labels = scales::label_log() + ) + } + + # Create the list of plots for each unique group + plot_list <- list() + for (id_val in unique(adpc[["id_plot"]])) { + + plot_data <- adpc %>% dplyr::filter(id_plot == id_val) + plot_list <- c(plot_list, list(plot %+% plot_data)) } - p + # Define IDs to differentiate each group of plots + names(plot_list) <- unique(adpc[["id_plot"]]) + + # Return the list of plots as output of the function + return(plot_list) } -#' @export -g_pkconc_ind_lin <- function(data, ...) { - g_pkconc_ind(data = data, scale = "lin", ...) +#' Add Figure Details to Data Frame +#' +#' This function adds figure details; title, subtitle, and caption to the data. +#' +#' @param adpc A data frame containing the data. +#' @param plotgroup_vars A character vector of the grouping data variables. +#' @param plotgroup_names A character vector for the grouping variables names. +#' @param studyid A character string specifying the study ID variable. +#' @param xvar_unit A character string for the unit for the x-axis variable. +#' @param xmin A numeric value specifying the minimum x-axis limit. +#' @param xmax A numeric value specifying the maximum x-axis limit. +#' @param footnote A character string specifying plot's manual footnote. +#' @param trt_var A character string specifying the treatment variable. +#' @param title A character string specifying the title for the plot. +#' @returns A data frame with added figure details. +#' @importFrom dplyr mutate across rowwise ungroup group_by n +#' @author Gerardo Rodriguez +add_figure_details <- function( + adpc, + title = "", # Specified by metadata + collapse_subtitle = "\n", + studyid = NULL, # Include or not in t + trt_var, # Include or not in subtitle + plotgroup_vars, + plotgroup_names, + xvar_unit, + xmin = NA, + xmax = NA, + footnote = NULL +) { + adpc %>% + mutate(across(all_of(plotgroup_vars), as.character)) %>% + rowwise() %>% + dplyr::mutate( + title = if (is.null(studyid)) title else paste0(title, ", by Cohort: ", !!sym(studyid)), + subtitle = paste( + paste(c(plotgroup_names), ": ", c_across(all_of(plotgroup_vars)), sep = ""), + collapse = collapse_subtitle + ), + footnote = { + footnote <- ifelse( + is.na(xmax), + yes = "", + no = paste0("Plot not showing observations beyond ", xmax, " ", !!sym(xvar_unit), ".") + ) + if (!is.na(xmin)) { + footnote <- paste0( + footnote, "\nPlot not showing observations before ", xmin, " ", !!sym(xvar_unit), "." + ) + } + + if (!is.null(footnote)) + footnote <- footnote + + footnote + } + ) %>% + ungroup() %>% + dplyr::mutate(id_plot = interaction(!!!syms(plotgroup_vars))) %>% + dplyr::group_by(!!!syms(c(trt_var, plotgroup_vars))) %>% + dplyr::mutate( + subtitle = paste0("Treatment Group: ", !!sym(trt_var), " (N=", n(), ")\n", subtitle) + ) %>% + ungroup() } -#' @export -g_pkconc_ind_log <- function(data, ...) { - g_pkconc_ind(data, scale = "log", ...) +#' Filter Breaks for X-Axis +#' +#' Filters X-axis for consecutive breaks with at least the specified distance. +#' +#' @param x_breaks A numeric vector of x-axis breaks. +#' @param plot A ggplot object used to extract plot dimensions and scales. +#' @param min_cm_distance A numeric of the minimum distance between breaks. +#' @returns A numeric vector of filtered x-axis breaks. +#' @importFrom ggplot2 ggplot_build ggplot_gtable +#' @importFrom grid convertUnit +#' @author Gerardo Rodriguez +filter_breaks <- function(x_breaks = NA, plot = plot, min_cm_distance = 0.5) { + x_breaks <- unique(na.omit(sort(x_breaks))) + plot_build <- ggplot_build(plot) + plot_table <- ggplot_gtable(plot_build) + + # Extract x-axis scale information + x_scale <- plot_build$layout$panel_params[[1]]$x.range + + # Identify the panel grob + panel_index <- which(sapply(plot_table$grobs, \(x) grepl("panel", x$name))) + + if (length(panel_index) == 0) { + stop("Error: Panel grob not found.") + } + panel <- plot_table$grobs[[panel_index]] + + # Extract the panel border grob to get the width + panel_border <- panel$children[[ + which(sapply(panel$children, \(x) grepl("panel.border", x$name))) + ]] + + # Convert panel width to cm + panel_width_cm <- grid::convertUnit(panel_border$width, unitTo = "cm", valueOnly = TRUE) + + # Filter only breaks that satisfy the minimum distance + filt_breaks <- x_breaks[1] + + for (i in 2:length(x_breaks)) { + # Take latest selected break and calculate its distance + b0 <- filt_breaks[length(filt_breaks)] + bdist <- (x_breaks[i] - b0) / diff(x_scale) * panel_width_cm + + if (bdist >= min_cm_distance) { + filt_breaks <- c(filt_breaks, x_breaks[i]) + } + } + + filt_breaks } \ No newline at end of file diff --git a/inst/shiny/tlg.yaml b/inst/shiny/tlg.yaml index e8e4a86..e23aeef 100644 --- a/inst/shiny/tlg.yaml +++ b/inst/shiny/tlg.yaml @@ -22,9 +22,14 @@ g_pkconc_ind_lin: description: "Individual plots of concentrations vs. time (one plot per patient/subject) with linear scale" link: https://insightsengineering.github.io/tlg-catalog/stable/graphs/pharmacokinetic/pkcg01.html fun: g_pkconc_ind_lin - opts: + opts: + - footnote - xlab - ylab + - xmin + - xmax + - ymin + - ymax g_pkconc_ind_log: is_default: true type: Graph @@ -35,6 +40,10 @@ g_pkconc_ind_log: link: https://insightsengineering.github.io/tlg-catalog/stable/graphs/pharmacokinetic/pkcg01.html fun: g_pkconc_ind_log opts: + - footnote - xlab - ylab - \ No newline at end of file + - xmin + - xmax + - ymin + - ymax \ No newline at end of file From b03ad403776aaa49b8b1628a5baed030c4a6a66a Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 28 Nov 2024 13:14:25 +0100 Subject: [PATCH 29/93] feat: support for numeric and text values --- inst/shiny/modules/tlg_plot.R | 20 ++++++++++++----- inst/shiny/tlg.yaml | 42 +++++++++++++++++++++++------------ 2 files changed, 42 insertions(+), 20 deletions(-) diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R index 663aef3..67e83b7 100644 --- a/inst/shiny/modules/tlg_plot.R +++ b/inst/shiny/modules/tlg_plot.R @@ -62,7 +62,7 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { plot_options <- purrr::list_modify(list(data = data()), !!!reactiveValuesToList(opts)) purrr::iwalk(plot_options, \(value, name) { - if (isTRUE(value == "")) + if (isTRUE(value %in% c(NULL, "", 0))) plot_options[[name]] <<- NULL }) @@ -75,15 +75,23 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { opts <- reactiveValues() - option_widgets <- lapply(options, function(opt_id) { + option_widgets <- purrr::imap(options, function(opt_def, opt_id) { observeEvent(input[[opt_id]], { opts[[opt_id]] <- input[[opt_id]] }) - textInput( - session$ns(opt_id), - label = opt_id - ) + if (opt_def$type == "text") { + textInput( + session$ns(opt_id), + label = opt_id + ) + } else if (opt_def$type == "numeric") { + numericInput( + session$ns(opt_id), + label = opt_id, + value = 0 + ) + } }) output$options <- renderUI(option_widgets) diff --git a/inst/shiny/tlg.yaml b/inst/shiny/tlg.yaml index e23aeef..3ea9201 100644 --- a/inst/shiny/tlg.yaml +++ b/inst/shiny/tlg.yaml @@ -23,13 +23,20 @@ g_pkconc_ind_lin: link: https://insightsengineering.github.io/tlg-catalog/stable/graphs/pharmacokinetic/pkcg01.html fun: g_pkconc_ind_lin opts: - - footnote - - xlab - - ylab - - xmin - - xmax - - ymin - - ymax + footnote: + type: text + xlab: + type: text + ylab: + type: text + xmin: + type: numeric + xmax: + type: numeric + ymin: + type: numeric + ymax: + type: numeric g_pkconc_ind_log: is_default: true type: Graph @@ -40,10 +47,17 @@ g_pkconc_ind_log: link: https://insightsengineering.github.io/tlg-catalog/stable/graphs/pharmacokinetic/pkcg01.html fun: g_pkconc_ind_log opts: - - footnote - - xlab - - ylab - - xmin - - xmax - - ymin - - ymax \ No newline at end of file + footnote: + type: text + xlab: + type: text + ylab: + type: text + xmin: + type: numeric + xmax: + type: numeric + ymin: + type: numeric + ymax: + type: numeric \ No newline at end of file From c6aeddfe01a13898a3091122249f47f9b5d70c70 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 28 Nov 2024 13:16:13 +0100 Subject: [PATCH 30/93] feat: added support for custom labels for inputs --- inst/shiny/modules/tlg_plot.R | 6 ++++-- inst/shiny/tlg.yaml | 6 ++++++ 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R index 67e83b7..555e32f 100644 --- a/inst/shiny/modules/tlg_plot.R +++ b/inst/shiny/modules/tlg_plot.R @@ -80,15 +80,17 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { opts[[opt_id]] <- input[[opt_id]] }) + label <- if (is.null(opt_def$label)) opt_id else opt_def$label + if (opt_def$type == "text") { textInput( session$ns(opt_id), - label = opt_id + label = label ) } else if (opt_def$type == "numeric") { numericInput( session$ns(opt_id), - label = opt_id, + label = label, value = 0 ) } diff --git a/inst/shiny/tlg.yaml b/inst/shiny/tlg.yaml index 3ea9201..e1023d6 100644 --- a/inst/shiny/tlg.yaml +++ b/inst/shiny/tlg.yaml @@ -25,10 +25,13 @@ g_pkconc_ind_lin: opts: footnote: type: text + label: Footnote xlab: type: text + label: X axis label ylab: type: text + label: Y axis label xmin: type: numeric xmax: @@ -49,10 +52,13 @@ g_pkconc_ind_log: opts: footnote: type: text + label: Footnote xlab: type: text + label: X axis label ylab: type: text + label: Y axis label xmin: type: numeric xmax: From 0df4e44b639ba81b295dbd1d4fcae93b0a38370f Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 28 Nov 2024 16:14:28 +0100 Subject: [PATCH 31/93] feat: support for select options --- inst/shiny/modules/tlg_plot.R | 39 ++++++++++++++++++++++++----------- inst/shiny/tlg.yaml | 19 ++++++++++++++++- 2 files changed, 45 insertions(+), 13 deletions(-) diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R index 555e32f..dfac27d 100644 --- a/inst/shiny/modules/tlg_plot.R +++ b/inst/shiny/modules/tlg_plot.R @@ -82,18 +82,33 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { label <- if (is.null(opt_def$label)) opt_id else opt_def$label - if (opt_def$type == "text") { - textInput( - session$ns(opt_id), - label = label - ) - } else if (opt_def$type == "numeric") { - numericInput( - session$ns(opt_id), - label = label, - value = 0 - ) - } + switch( + opt_def$type, + text = { + textInput( + session$ns(opt_id), + label = label, + value = "" + ) + }, + numeric = { + numericInput( + session$ns(opt_id), + label = label, + value = 0 + ) + }, + select = { + choices <- if (isTRUE(opt_def$choices == ".colnames")) names(data()) else opt_def$choices + selectInput( + session$ns(opt_id), + label = label, + selected = "", + choices = c("", choices), + multiple = isTRUE(opt_def$multiple) + ) + } + ) }) output$options <- renderUI(option_widgets) diff --git a/inst/shiny/tlg.yaml b/inst/shiny/tlg.yaml index e1023d6..14dcfa3 100644 --- a/inst/shiny/tlg.yaml +++ b/inst/shiny/tlg.yaml @@ -22,7 +22,24 @@ g_pkconc_ind_lin: description: "Individual plots of concentrations vs. time (one plot per patient/subject) with linear scale" link: https://insightsengineering.github.io/tlg-catalog/stable/graphs/pharmacokinetic/pkcg01.html fun: g_pkconc_ind_lin - opts: + opts: + xvar: + type: select + label: X axis + choices: .colnames + yvar: + type: select + label: Y axis + choices: .colnames + plotgroup_vars: + type: select + label: "Grouping variables" + multiple: true + choices: + - ROUTE + - PCSPEC + - PARAM + - USUBJID footnote: type: text label: Footnote From fedea42f21155497f1a25e5871c760f14c8317b7 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 28 Nov 2024 16:14:41 +0100 Subject: [PATCH 32/93] fix: axis units --- R/g_pkconc_ind.R | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/R/g_pkconc_ind.R b/R/g_pkconc_ind.R index 963cfc3..0550202 100644 --- a/R/g_pkconc_ind.R +++ b/R/g_pkconc_ind.R @@ -85,8 +85,8 @@ pkcg01 <- function( # " (", unique(adpc[[xvar_unit]]), ")")), # ylab = substitute(paste0(attr(adpc[[yvar]], "label"), # " (", unique(adpc[[yvar_unit]]), ")")), - xlab = paste0(xvar, " [", xvar_unit, "]"), - ylab = paste0(yvar, " [", yvar_unit, "]"), + xlab = paste0(xvar, " [", unique(adpc[[xvar_unit]]), "]"), + ylab = paste0(yvar, " [", unique(adpc[[yvar_unit]]), "]"), footnote = NULL, # Inputs to split-by/seggregate plots plotgroup_vars = c("ROUTE", "PCSPEC", "PARAM", "USUBJID"), @@ -97,7 +97,6 @@ pkcg01 <- function( studyid = "STUDYID", trt_var = "TRT01A" ) { - xmin <- as.numeric(xmin) xmax <- as.numeric(xmax) ymin <- as.numeric(ymin) From 35a8c62abdf896834835d7230e2481c473e1b5ea Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 28 Nov 2024 16:27:01 +0100 Subject: [PATCH 33/93] fix: footnote --- R/g_pkconc_ind.R | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/R/g_pkconc_ind.R b/R/g_pkconc_ind.R index 0550202..88c9191 100644 --- a/R/g_pkconc_ind.R +++ b/R/g_pkconc_ind.R @@ -273,19 +273,20 @@ add_figure_details <- function( collapse = collapse_subtitle ), footnote = { - footnote <- ifelse( - is.na(xmax), - yes = "", - no = paste0("Plot not showing observations beyond ", xmax, " ", !!sym(xvar_unit), ".") - ) - if (!is.na(xmin)) { + footnote <- if (is.null(footnote)) "" else paste0(footnote, "\n") + + if (!is.na(xmax)) { footnote <- paste0( - footnote, "\nPlot not showing observations before ", xmin, " ", !!sym(xvar_unit), "." + footnote, + "Plot not showing observations beyond ", xmax, " ", !!sym(xvar_unit), ".\n" ) } - if (!is.null(footnote)) - footnote <- footnote + if (!is.na(xmin)) { + footnote <- paste0( + footnote, "Plot not showing observations before ", xmin, " ", !!sym(xvar_unit), ".\n" + ) + } footnote } From 58feff711b7f2cdfc1df4ccc907b96aeb3c5d76d Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 28 Nov 2024 16:52:46 +0100 Subject: [PATCH 34/93] fix: all plots showing static reference titles and captions --- R/g_pkconc_ind.R | 25 +++++++++++-------------- 1 file changed, 11 insertions(+), 14 deletions(-) diff --git a/R/g_pkconc_ind.R b/R/g_pkconc_ind.R index 88c9191..8b1ab7f 100644 --- a/R/g_pkconc_ind.R +++ b/R/g_pkconc_ind.R @@ -140,9 +140,6 @@ pkcg01 <- function( id_var = "subtitle", add_baseline_hline = FALSE, yvar_baseline = yvar, - title = unique(plot_data$title), - subtitle = unique(plot_data$subtitle), - caption = unique(plot_data$footnote), plotting_choices = "separate_by_obs" )[[1]] @@ -219,18 +216,18 @@ pkcg01 <- function( } # Create the list of plots for each unique group - plot_list <- list() - for (id_val in unique(adpc[["id_plot"]])) { - + lapply(unique(adpc[["id_plot"]]), \(id_val) { plot_data <- adpc %>% dplyr::filter(id_plot == id_val) - plot_list <- c(plot_list, list(plot %+% plot_data)) - } - - # Define IDs to differentiate each group of plots - names(plot_list) <- unique(adpc[["id_plot"]]) - - # Return the list of plots as output of the function - return(plot_list) + plot %+% + labs( + title = unique(plot_data$title), + subtitle = unique(plot_data$subtitle), + caption = unique(plot_data$footnote), + ) %+% + plot_data + + }) |> + setNames(unique(adpc[["id_plot"]])) } #' Add Figure Details to Data Frame From 3e72b63d2df607ceb8968e4247a8796f45cb3ab0 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 28 Nov 2024 17:03:24 +0100 Subject: [PATCH 35/93] feat: smaller left selection panel --- inst/shiny/modules/tab_tlg.R | 1 + 1 file changed, 1 insertion(+) diff --git a/inst/shiny/modules/tab_tlg.R b/inst/shiny/modules/tab_tlg.R index 190f2cb..cde332a 100644 --- a/inst/shiny/modules/tab_tlg.R +++ b/inst/shiny/modules/tab_tlg.R @@ -286,6 +286,7 @@ tab_tlg_server <- function(id, data) { tabPanel(g_def$label, plot_ui) }) + panels$"widths" <- c(2, 10) output$graphs <- renderUI({ do.call(navlistPanel, panels) }) From 5ac2b65d1ad3454cc4dccc7a0b24782bf0ddfd72 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 28 Nov 2024 17:11:21 +0100 Subject: [PATCH 36/93] feat: converted ggplot to plotly --- R/g_pkconc_ind.R | 3 ++- inst/shiny/modules/tlg_plot.R | 4 ++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/R/g_pkconc_ind.R b/R/g_pkconc_ind.R index 8b1ab7f..c25b31e 100644 --- a/R/g_pkconc_ind.R +++ b/R/g_pkconc_ind.R @@ -224,7 +224,8 @@ pkcg01 <- function( subtitle = unique(plot_data$subtitle), caption = unique(plot_data$footnote), ) %+% - plot_data + plot_data %>% + ggplotly(tooltip = c("x", "y")) }) |> setNames(unique(adpc[["id_plot"]])) diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R index dfac27d..3d932d9 100644 --- a/inst/shiny/modules/tlg_plot.R +++ b/inst/shiny/modules/tlg_plot.R @@ -20,7 +20,7 @@ tlg_plot_ui <- function(id) { div(align = "right", actionButton(ns("next_page"), "Next Page")) ), # Plots display # - plotOutput(ns("plot")) + plotlyOutput(ns("plot")) ), column( width = 3, @@ -69,7 +69,7 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { do.call(render_plot, plot_options) }) - output$plot <- renderPlot({ + output$plot <- renderPlotly({ plot_list()[[current_page()]] }) From a0fa727caff85f70e06ba537297ef00b643b985e Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 12 Dec 2024 08:21:18 +0100 Subject: [PATCH 37/93] refactor: renamed opts to options --- inst/shiny/modules/tab_tlg.R | 2 +- inst/shiny/modules/tlg_plot.R | 4 ++-- inst/shiny/tlg.yaml | 4 ++-- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/inst/shiny/modules/tab_tlg.R b/inst/shiny/modules/tab_tlg.R index cde332a..4397ca9 100644 --- a/inst/shiny/modules/tab_tlg.R +++ b/inst/shiny/modules/tab_tlg.R @@ -276,7 +276,7 @@ tab_tlg_server <- function(id, data) { g_def <- .TLG_DEFINITIONS[[g_id]] if (exists(g_def$fun)) { - tlg_plot_server(g_id, get(g_def$fun), g_def$opts, data) + tlg_plot_server(g_id, get(g_def$fun), g_def$options, data) tlg_plot_ui(session$ns(g_id)) } else { tags$div("Plot not implemented yet") diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R index 3d932d9..de514d4 100644 --- a/inst/shiny/modules/tlg_plot.R +++ b/inst/shiny/modules/tlg_plot.R @@ -73,11 +73,11 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { plot_list()[[current_page()]] }) - opts <- reactiveValues() + options <- reactiveValues() option_widgets <- purrr::imap(options, function(opt_def, opt_id) { observeEvent(input[[opt_id]], { - opts[[opt_id]] <- input[[opt_id]] + options[[opt_id]] <- input[[opt_id]] }) label <- if (is.null(opt_def$label)) opt_id else opt_def$label diff --git a/inst/shiny/tlg.yaml b/inst/shiny/tlg.yaml index 14dcfa3..90e8591 100644 --- a/inst/shiny/tlg.yaml +++ b/inst/shiny/tlg.yaml @@ -22,7 +22,7 @@ g_pkconc_ind_lin: description: "Individual plots of concentrations vs. time (one plot per patient/subject) with linear scale" link: https://insightsengineering.github.io/tlg-catalog/stable/graphs/pharmacokinetic/pkcg01.html fun: g_pkconc_ind_lin - opts: + options: xvar: type: select label: X axis @@ -66,7 +66,7 @@ g_pkconc_ind_log: description: "Individual plots of concentrations vs. time (one plot per patient/subject) with log10 scale" link: https://insightsengineering.github.io/tlg-catalog/stable/graphs/pharmacokinetic/pkcg01.html fun: g_pkconc_ind_log - opts: + options: footnote: type: text label: Footnote From 4d2e4fff5d1123af059c33f4d70d57f14d66af7a Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 12 Dec 2024 08:23:20 +0100 Subject: [PATCH 38/93] feat: added target=_blank to links in the tlg table --- inst/shiny/modules/tab_tlg.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/inst/shiny/modules/tab_tlg.R b/inst/shiny/modules/tab_tlg.R index 4397ca9..a908352 100644 --- a/inst/shiny/modules/tab_tlg.R +++ b/inst/shiny/modules/tab_tlg.R @@ -88,7 +88,7 @@ tab_tlg_server <- function(id, data) { Selection = x$is_default, Type = x$type, Dataset = x$dataset, - PKid = paste0("", x$pkid, ""), + PKid = paste0("", x$pkid, ""), Description = x$description ) }) From c64f3b4607f79fe28a259bfffa5d949ae9e2b965 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 12 Dec 2024 08:41:19 +0100 Subject: [PATCH 39/93] refactor: better tlg talbe generation --- inst/shiny/modules/tab_tlg.R | 37 ++++++++++++------------------------ 1 file changed, 12 insertions(+), 25 deletions(-) diff --git a/inst/shiny/modules/tab_tlg.R b/inst/shiny/modules/tab_tlg.R index a908352..2fa32b0 100644 --- a/inst/shiny/modules/tab_tlg.R +++ b/inst/shiny/modules/tab_tlg.R @@ -68,31 +68,18 @@ tab_tlg_server <- function(id, data) { # Make available the CSV file with the TLG list and available links to NEST tlg_order <- reactiveVal({ - tlg_data <- dplyr::tibble( - id = character(), - Selection = logical(), - Type = character(), - Dataset = character(), - PKid = character(), - Description = character(), - Footnote = character(), - Stratification = character(), - Condition = character(), - Comment = character() - ) - - purrr::iwalk(.TLG_DEFINITIONS, function(x, id) { - tlg_data <<- dplyr::add_row( - tlg_data, - id = id, - Selection = x$is_default, - Type = x$type, - Dataset = x$dataset, - PKid = paste0("", x$pkid, ""), - Description = x$description - ) - }) - tlg_data + purrr::map_dfr(.TLG_DEFINITIONS, ~ dplyr::tibble( + Selection = .x$is_default, + Type = .x$type, + Dataset = .x$dataset, + PKid = paste0("", .x$pkid, ""), + Description = .x$description, + Footnote = NA_character_, + Stratification = NA_character_, + Condition = NA_character_, + Comment = NA_character_ + )) %>% + dplyr::mutate(id = dplyr::row_number(), .before = dplyr::everything()) }) # Based on the TLG list conditions for data() define the preselected rows in $Selection From 7016063736592e0751c33599043f7bba7798b605 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 12 Dec 2024 08:52:23 +0100 Subject: [PATCH 40/93] fix: plot module crashing --- inst/shiny/modules/tlg_plot.R | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R index de514d4..c43b61d 100644 --- a/inst/shiny/modules/tlg_plot.R +++ b/inst/shiny/modules/tlg_plot.R @@ -59,7 +59,7 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { plot_list <- reactive({ - plot_options <- purrr::list_modify(list(data = data()), !!!reactiveValuesToList(opts)) + plot_options <- purrr::list_modify(list(data = data()), !!!reactiveValuesToList(options_)) purrr::iwalk(plot_options, \(value, name) { if (isTRUE(value %in% c(NULL, "", 0))) @@ -73,11 +73,10 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { plot_list()[[current_page()]] }) - options <- reactiveValues() - + options_ <- reactiveValues() option_widgets <- purrr::imap(options, function(opt_def, opt_id) { observeEvent(input[[opt_id]], { - options[[opt_id]] <- input[[opt_id]] + options_[[opt_id]] <- input[[opt_id]] }) label <- if (is.null(opt_def$label)) opt_id else opt_def$label From 1db1998cc4aeaec87aad7e933c7ae10a5e6ccf5d Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 12 Dec 2024 08:52:56 +0100 Subject: [PATCH 41/93] refactor: removed mixing patterns --- inst/shiny/modules/tab_tlg.R | 5 ++++- inst/shiny/tlg.yaml | 2 +- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/inst/shiny/modules/tab_tlg.R b/inst/shiny/modules/tab_tlg.R index 2fa32b0..06eb2df 100644 --- a/inst/shiny/modules/tab_tlg.R +++ b/inst/shiny/modules/tab_tlg.R @@ -257,7 +257,10 @@ tab_tlg_server <- function(id, data) { choices = "") } - tlg_order_graphs <- filter(tlg_order_filt, Type == "Graph")$id + tlg_order_graphs <- filter(tlg_order_filt, Type == "Graph") %>% + select("id") %>% + pull() + panels <- lapply(tlg_order_graphs, function(g_id) { plot_ui <- { g_def <- .TLG_DEFINITIONS[[g_id]] diff --git a/inst/shiny/tlg.yaml b/inst/shiny/tlg.yaml index 90e8591..72018d4 100644 --- a/inst/shiny/tlg.yaml +++ b/inst/shiny/tlg.yaml @@ -83,4 +83,4 @@ g_pkconc_ind_log: ymin: type: numeric ymax: - type: numeric \ No newline at end of file + type: numeric From 7041c64f2055f3f14b7994efbd291a64ea05e6df Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 12 Dec 2024 09:43:34 +0100 Subject: [PATCH 42/93] docs: updated documentation --- NAMESPACE | 10 +++- inst/shiny/tlg.yaml | 15 ++++-- man/add_figure_details.Rd | 50 ++++++++++++++++++++ man/filter_breaks.Rd | 14 ++++-- man/g_pkconc_ind_lin.Rd | 19 ++++++++ man/g_pkconc_ind_log.Rd | 19 ++++++++ man/pkcg01.Rd | 98 +++++++++++++++++++++++++++++++++++++++ 7 files changed, 215 insertions(+), 10 deletions(-) create mode 100644 man/add_figure_details.Rd create mode 100644 man/g_pkconc_ind_lin.Rd create mode 100644 man/g_pkconc_ind_log.Rd create mode 100644 man/pkcg01.Rd diff --git a/NAMESPACE b/NAMESPACE index a4b7fd3..78a8e5f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -9,7 +9,6 @@ export(create_dose) export(filter_breaks) export(flexible_violinboxplot) export(format_data) -export(g_pkconc_ind) export(g_pkconc_ind_lin) export(g_pkconc_ind_log) export(general_lineplot) @@ -17,6 +16,7 @@ export(general_meanplot) export(geometric_mean) export(has_label) export(lambda_slope_plot) +export(pkcg01) export(pptestcd_dict) export(reshape_pknca_results) export(run_app) @@ -40,6 +40,7 @@ importFrom(PKNCA,PKNCAdata) importFrom(PKNCA,PKNCAdose) importFrom(PKNCA,pk.nca) importFrom(PKNCA,pknca_units_table) +importFrom(checkmate,assert_numeric) importFrom(dplyr,across) importFrom(dplyr,arrange) importFrom(dplyr,case_when) @@ -48,14 +49,17 @@ importFrom(dplyr,filter) importFrom(dplyr,group_by) importFrom(dplyr,left_join) importFrom(dplyr,mutate) +importFrom(dplyr,n) importFrom(dplyr,pull) importFrom(dplyr,rename) importFrom(dplyr,rename_with) +importFrom(dplyr,rowwise) importFrom(dplyr,select) importFrom(dplyr,slice) importFrom(dplyr,summarise) importFrom(dplyr,ungroup) importFrom(dplyr,where) +importFrom(ggh4x,scale_y_facet) importFrom(ggplot2,aes) importFrom(ggplot2,facet_wrap) importFrom(ggplot2,geom_errorbar) @@ -65,6 +69,7 @@ importFrom(ggplot2,ggplot) importFrom(ggplot2,ggplot_build) importFrom(ggplot2,ggplot_gtable) importFrom(ggplot2,labs) +importFrom(ggplot2,scale_x_continuous) importFrom(grid,convertUnit) importFrom(htmlwidgets,JS) importFrom(logger,log_debug) @@ -87,6 +92,9 @@ importFrom(reactable.extras,dropdown_extra) importFrom(reactable.extras,text_extra) importFrom(rio,export_list) importFrom(rmarkdown,render) +importFrom(scales,breaks_log) +importFrom(scales,label_log) +importFrom(scales,trans_breaks) importFrom(shinyBS,bsModal) importFrom(shinyFiles,shinyDirChoose) importFrom(shinyWidgets,dropdown) diff --git a/inst/shiny/tlg.yaml b/inst/shiny/tlg.yaml index 72018d4..06612ab 100644 --- a/inst/shiny/tlg.yaml +++ b/inst/shiny/tlg.yaml @@ -8,11 +8,16 @@ # label: # short label to display as tab name # description: # longer descriptions, to be displayed in the order table # link: # link to the documentation of the TLG -# fun: # name of the function exported by the package, responsible for generating TLG -# opts: # options that can be passed as arguments to the function -# - option1 # will generate input widgets for editing -# - option2 # TODO: add ability to specify default value and type - +# fun: # name of the function exported by the package, responsible for generating TLG, must +# # return a list of plots to be displayed +# options: # options that can be passed as arguments to the function +# optname: # option name, the same as the argument that is passed to the rendering function +# type: # type of the option/widget, one of: text, numeric, select +# label: # label to be displayed in the editing widget +# multiple: # applicable to 'select' type, whether to allow for multiple values to be selected +# choices: # applicable to 'select' type, choices to pick from the dropdown, either specified +# # outright or using a special keyword: + # - .colnames keyword will pull the choices from the data column names g_pkconc_ind_lin: is_default: true type: Graph diff --git a/man/add_figure_details.Rd b/man/add_figure_details.Rd new file mode 100644 index 0000000..fa7c397 --- /dev/null +++ b/man/add_figure_details.Rd @@ -0,0 +1,50 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/g_pkconc_ind.R +\name{add_figure_details} +\alias{add_figure_details} +\title{Add Figure Details to Data Frame} +\usage{ +add_figure_details( + adpc, + title = "", + collapse_subtitle = "\\n", + studyid = NULL, + trt_var, + plotgroup_vars, + plotgroup_names, + xvar_unit, + xmin = NA, + xmax = NA, + footnote = NULL +) +} +\arguments{ +\item{adpc}{A data frame containing the data.} + +\item{title}{A character string specifying the title for the plot.} + +\item{studyid}{A character string specifying the study ID variable.} + +\item{trt_var}{A character string specifying the treatment variable.} + +\item{plotgroup_vars}{A character vector of the grouping data variables.} + +\item{plotgroup_names}{A character vector for the grouping variables names.} + +\item{xvar_unit}{A character string for the unit for the x-axis variable.} + +\item{xmin}{A numeric value specifying the minimum x-axis limit.} + +\item{xmax}{A numeric value specifying the maximum x-axis limit.} + +\item{footnote}{A character string specifying plot's manual footnote.} +} +\value{ +A data frame with added figure details. +} +\description{ +This function adds figure details; title, subtitle, and caption to the data. +} +\author{ +Gerardo Rodriguez +} diff --git a/man/filter_breaks.Rd b/man/filter_breaks.Rd index 3514856..3bb7930 100644 --- a/man/filter_breaks.Rd +++ b/man/filter_breaks.Rd @@ -1,22 +1,28 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/filter_breaks.R +% Please edit documentation in R/filter_breaks.R, R/g_pkconc_ind.R \name{filter_breaks} \alias{filter_breaks} \title{Filter Breaks for X-Axis} \usage{ -filter_breaks(breaks = NA, plot = plot, min_cm_distance = 0.5, axis = "x") +filter_breaks(x_breaks = NA, plot = plot, min_cm_distance = 0.5) + +filter_breaks(x_breaks = NA, plot = plot, min_cm_distance = 0.5) } \arguments{ +\item{x_breaks}{A numeric vector of x-axis breaks.} + \item{plot}{A ggplot object used to extract plot dimensions and scales.} \item{min_cm_distance}{A numeric of the minimum distance between breaks.} - -\item{x_breaks}{A numeric vector of x-axis breaks.} } \value{ +A numeric vector of filtered x-axis breaks. + A numeric vector of filtered x-axis breaks. } \description{ +Filters X-axis for consecutive breaks with at least the specified distance. + Filters X-axis for consecutive breaks with at least the specified distance. } \author{ diff --git a/man/g_pkconc_ind_lin.Rd b/man/g_pkconc_ind_lin.Rd new file mode 100644 index 0000000..bc065e9 --- /dev/null +++ b/man/g_pkconc_ind_lin.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/g_pkconc_ind.R +\name{g_pkconc_ind_lin} +\alias{g_pkconc_ind_lin} +\title{Wrapper around aNCA::pkcg01() function. Calls the function with \code{LIN} scale argument.} +\usage{ +g_pkconc_ind_lin(data, ...) +} +\arguments{ +\item{data}{Data to be passed into the plotting function.} + +\item{...}{Any other parameters to be passed into the ploting function.} +} +\value{ +ggplot2 object for pckg01. +} +\description{ +Wrapper around aNCA::pkcg01() function. Calls the function with \code{LIN} scale argument. +} diff --git a/man/g_pkconc_ind_log.Rd b/man/g_pkconc_ind_log.Rd new file mode 100644 index 0000000..4e3aecb --- /dev/null +++ b/man/g_pkconc_ind_log.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/g_pkconc_ind.R +\name{g_pkconc_ind_log} +\alias{g_pkconc_ind_log} +\title{Wrapper around aNCA::pkcg01() function. Calls the function with \code{LOG} scale argument.} +\usage{ +g_pkconc_ind_log(data, ...) +} +\arguments{ +\item{data}{Data to be passed into the plotting function.} + +\item{...}{Any other parameters to be passed into the ploting function.} +} +\value{ +ggplot2 object for pckg01. +} +\description{ +Wrapper around aNCA::pkcg01() function. Calls the function with \code{LOG} scale argument. +} diff --git a/man/pkcg01.Rd b/man/pkcg01.Rd new file mode 100644 index 0000000..7987d25 --- /dev/null +++ b/man/pkcg01.Rd @@ -0,0 +1,98 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/g_pkconc_ind.R +\name{pkcg01} +\alias{pkcg01} +\title{Generate PK Concentration-Time Profile Plots} +\usage{ +pkcg01( + adpc = data(), + xvar = "AFRLT", + yvar = "AVAL", + xvar_unit = "RRLTU", + yvar_unit = "AVALU", + color_var = NULL, + color_var_label = NULL, + xbreaks_var = "NFRLT", + xbreaks_mindist = 0.5, + xmin = NA, + xmax = NA, + ymin = NA, + ymax = NA, + xlab = paste0(xvar, " [", unique(adpc[[xvar_unit]]), "]"), + ylab = paste0(yvar, " [", unique(adpc[[yvar_unit]]), "]"), + footnote = NULL, + plotgroup_vars = c("ROUTE", "PCSPEC", "PARAM", "USUBJID"), + plotgroup_names = c("Route", "Specimen", "Analyte", "Subject ID"), + scale = c("LIN", "LOG", "SBS")[1], + studyid = "STUDYID", + trt_var = "TRT01A" +) +} +\arguments{ +\item{adpc}{A data frame containing the data.} + +\item{xvar}{A character string of the variable name for the x-axis.} + +\item{yvar}{A character string of the variable name for the y-axis.} + +\item{xvar_unit}{A character string of the unit for the x-axis variable.} + +\item{yvar_unit}{A character string of the unit for the y-axis variable.} + +\item{color_var}{A character string of the variable name for the color.} + +\item{color_var_label}{A character string of the color label.} + +\item{xbreaks_var}{A character string of the x-axis breaks.} + +\item{xmin}{A numeric value specifying the minimum x-axis limit.} + +\item{xmax}{A numeric value specifying the maximum x-axis limit.} + +\item{ymin}{A numeric value for the minimum y-axis limit.} + +\item{ymax}{A numeric value for the maximum y-axis limit.} + +\item{xlab}{Character for x-axis label. Defaults: \code{xvar} label & \code{xvar_unit}.} + +\item{ylab}{Character for y-axis label. Defaults: \code{yvar} label & \code{yvar_unit}.} + +\item{footnote}{A character string of a manual footnote for the plot.} + +\item{plotgroup_vars}{A character vector of the variables to group data.} + +\item{plotgroup_names}{A character vector of the grouping variable names.} + +\item{studyid}{A character string specifying the study ID variable.} + +\item{trt_var}{A character string specifying the treatment variable.} + +\item{options}{A list of additional options (e.g., display scale).} +} +\value{ +A list of ggplot objects for each unique group. +} +\description{ +This function generates a list of ggplots for PK concentration-time profiles. +} +\examples{ +\dontrun { + adpc <- read.csv("inst/shiny/data/DummyRO_ADNCA.csv") + attr(adpc[["AFRLT"]], "label") <- "Actual time from first dose" + attr(adpc[["AVAL"]], "label") <- "Analysis val + + plots_lin <- pkcg01(adpc = adpc, xmax = 1) + plots_log <- pkcg01(adpc = adpc, color_var = "USUBJID", scale = "LOG) + plots_sbs <- pkcg01( + adpc = adpc, + color_var = "USUBJID", + xbreaks_var = "NFRLT", + xmin = 100, xmax = 1000, + scale = "SBS" + ) +} + +} +\author{ +Gerardo Rodriguez +} From 8ef873a2f2f6586d60a7b4cd4d1c3846abb12e89 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 12 Dec 2024 09:50:19 +0100 Subject: [PATCH 43/93] feat: implemented keyword for selecting choices from data column --- inst/shiny/modules/tlg_plot.R | 10 +++++++++- inst/shiny/tlg.yaml | 1 + 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R index c43b61d..75d1906 100644 --- a/inst/shiny/modules/tlg_plot.R +++ b/inst/shiny/modules/tlg_plot.R @@ -98,7 +98,15 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { ) }, select = { - choices <- if (isTRUE(opt_def$choices == ".colnames")) names(data()) else opt_def$choices + choices <- { + if (isTRUE(opt_def$choices == ".colnames")) { + names(data()) + } else if (length(opt_def$choices) == 1 && grepl("^\\.", opt_def$choices)) { + unique(data()[, sub("^\\.", "", opt_def$choices)]) + } else { + opt_def$choices + } + } selectInput( session$ns(opt_id), label = label, diff --git a/inst/shiny/tlg.yaml b/inst/shiny/tlg.yaml index 06612ab..7e54652 100644 --- a/inst/shiny/tlg.yaml +++ b/inst/shiny/tlg.yaml @@ -18,6 +18,7 @@ # choices: # applicable to 'select' type, choices to pick from the dropdown, either specified # # outright or using a special keyword: # - .colnames keyword will pull the choices from the data column names + # - .COLUMN_NAME keyword will pull choices from values of a specific column g_pkconc_ind_lin: is_default: true type: Graph From 6be695826cd07b60816407742566732180ffb6a6 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 12 Dec 2024 10:02:17 +0100 Subject: [PATCH 44/93] feat: added ability to specify defaults --- inst/shiny/modules/tlg_plot.R | 19 ++++++++++++++++--- inst/shiny/tlg.yaml | 5 +++++ 2 files changed, 21 insertions(+), 3 deletions(-) diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R index 75d1906..3908dcc 100644 --- a/inst/shiny/modules/tlg_plot.R +++ b/inst/shiny/modules/tlg_plot.R @@ -87,14 +87,14 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { textInput( session$ns(opt_id), label = label, - value = "" + value = opt_def$default ) }, numeric = { numericInput( session$ns(opt_id), label = label, - value = 0 + value = opt_def$default ) }, select = { @@ -107,10 +107,23 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { opt_def$choices } } + + selected <- { + if (!is.null(opt_def$default)) { + if (opt_def$default == ".all") { + choices + } else { + opt_def$default + } + } else { + "" + } + } + selectInput( session$ns(opt_id), label = label, - selected = "", + selected = selected, choices = c("", choices), multiple = isTRUE(opt_def$multiple) ) diff --git a/inst/shiny/tlg.yaml b/inst/shiny/tlg.yaml index 7e54652..25acd3b 100644 --- a/inst/shiny/tlg.yaml +++ b/inst/shiny/tlg.yaml @@ -14,6 +14,9 @@ # optname: # option name, the same as the argument that is passed to the rendering function # type: # type of the option/widget, one of: text, numeric, select # label: # label to be displayed in the editing widget +# default: # default value to be provided in the field; if provided, will overwrite function +# # argument defaults. if left empty, function defaults will be applied; if type is selected, +# # '.all' keyword can be applied to select all choices # multiple: # applicable to 'select' type, whether to allow for multiple values to be selected # choices: # applicable to 'select' type, choices to pick from the dropdown, either specified # # outright or using a special keyword: @@ -40,6 +43,7 @@ g_pkconc_ind_lin: plotgroup_vars: type: select label: "Grouping variables" + default: .all multiple: true choices: - ROUTE @@ -52,6 +56,7 @@ g_pkconc_ind_lin: xlab: type: text label: X axis label + default: "Test default label" ylab: type: text label: Y axis label From 76bce038c1b79ceadfacdbb3272180aff1fff7e5 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 12 Dec 2024 10:04:52 +0100 Subject: [PATCH 45/93] docs: added comments, fixed spelling --- R/g_pkconc_ind.R | 8 ++++---- inst/WORDLIST | 2 ++ inst/shiny/modules/tlg_plot.R | 7 ++++++- man/g_pkconc_ind_lin.Rd | 4 ++-- man/g_pkconc_ind_log.Rd | 4 ++-- 5 files changed, 16 insertions(+), 9 deletions(-) diff --git a/R/g_pkconc_ind.R b/R/g_pkconc_ind.R index c25b31e..eee2b8d 100644 --- a/R/g_pkconc_ind.R +++ b/R/g_pkconc_ind.R @@ -1,7 +1,7 @@ #' Wrapper around aNCA::pkcg01() function. Calls the function with `LIN` scale argument. #' @param data Data to be passed into the plotting function. -#' @param ... Any other parameters to be passed into the ploting function. -#' @returns ggplot2 object for pckg01. +#' @param ... Any other parameters to be passed into the plotting function. +#' @returns ggplot2 object for pkcg01. #' @export g_pkconc_ind_lin <- function(data, ...) { pkcg01(adpc = data, scale = "LIN", ...) @@ -9,8 +9,8 @@ g_pkconc_ind_lin <- function(data, ...) { #' Wrapper around aNCA::pkcg01() function. Calls the function with `LOG` scale argument. #' @param data Data to be passed into the plotting function. -#' @param ... Any other parameters to be passed into the ploting function. -#' @returns ggplot2 object for pckg01. +#' @param ... Any other parameters to be passed into the plotting function. +#' @returns ggplot2 object for pkcg01. #' @export g_pkconc_ind_log <- function(data, ...) { pkcg01(adpc = data, scale = "LOG") diff --git a/inst/WORDLIST b/inst/WORDLIST index 548d118..8bd1774 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -30,8 +30,10 @@ cmax csv customizable ggplot +ggplots nca pharmacokinetic +pkcg pknca plotly pptest diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R index 3908dcc..4b4ed83 100644 --- a/inst/shiny/modules/tlg_plot.R +++ b/inst/shiny/modules/tlg_plot.R @@ -38,6 +38,7 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { observeEvent(input$previous_page, current_page(current_page() - 1)) observeEvent(input$select_page, current_page(as.numeric(input$select_page))) + #' when data is provided, set page to 1 and render appropriate UI observeEvent(data(), { current_page(1) output$page_number <- renderUI(length(plot_list())) @@ -51,13 +52,14 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { }) }) + #' updates UI responsible for page change observeEvent(current_page(), { shinyjs::toggleState(id = "previous_page", condition = current_page() > 1) shinyjs::toggleState(id = "next_page", condition = current_page() < length(plot_list())) updateSelectInput(session = session, inputId = "select_page", selected = current_page()) }) - + #' keeps list of plots to render, with options gathered from the UI and applied plot_list <- reactive({ plot_options <- purrr::list_modify(list(data = data()), !!!reactiveValuesToList(options_)) @@ -73,7 +75,10 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { plot_list()[[current_page()]] }) + #' holds options gathered from UI widgets options_ <- reactiveValues() + + #' creates widgets responsible for custimizing the plots option_widgets <- purrr::imap(options, function(opt_def, opt_id) { observeEvent(input[[opt_id]], { options_[[opt_id]] <- input[[opt_id]] diff --git a/man/g_pkconc_ind_lin.Rd b/man/g_pkconc_ind_lin.Rd index bc065e9..08e4817 100644 --- a/man/g_pkconc_ind_lin.Rd +++ b/man/g_pkconc_ind_lin.Rd @@ -9,10 +9,10 @@ g_pkconc_ind_lin(data, ...) \arguments{ \item{data}{Data to be passed into the plotting function.} -\item{...}{Any other parameters to be passed into the ploting function.} +\item{...}{Any other parameters to be passed into the plotting function.} } \value{ -ggplot2 object for pckg01. +ggplot2 object for pkcg01. } \description{ Wrapper around aNCA::pkcg01() function. Calls the function with \code{LIN} scale argument. diff --git a/man/g_pkconc_ind_log.Rd b/man/g_pkconc_ind_log.Rd index 4e3aecb..98dfdfd 100644 --- a/man/g_pkconc_ind_log.Rd +++ b/man/g_pkconc_ind_log.Rd @@ -9,10 +9,10 @@ g_pkconc_ind_log(data, ...) \arguments{ \item{data}{Data to be passed into the plotting function.} -\item{...}{Any other parameters to be passed into the ploting function.} +\item{...}{Any other parameters to be passed into the plotting function.} } \value{ -ggplot2 object for pckg01. +ggplot2 object for pkcg01. } \description{ Wrapper around aNCA::pkcg01() function. Calls the function with \code{LOG} scale argument. From fb61e0223f844582905b27caba193ff8d7708f73 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 12 Dec 2024 10:20:59 +0100 Subject: [PATCH 46/93] feat: added ability to provide grouping labels for the widgets --- inst/shiny/modules/tlg_plot.R | 4 ++++ inst/shiny/tlg.yaml | 6 ++++++ inst/shiny/www/style.css | 10 +++++++++- 3 files changed, 19 insertions(+), 1 deletion(-) diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R index 4b4ed83..9f39f67 100644 --- a/inst/shiny/modules/tlg_plot.R +++ b/inst/shiny/modules/tlg_plot.R @@ -80,6 +80,10 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { #' creates widgets responsible for custimizing the plots option_widgets <- purrr::imap(options, function(opt_def, opt_id) { + if (grepl(".group_label", opt_id)) { + return(tags$h1(opt_def, class = "tlg-group-label")) + } + observeEvent(input[[opt_id]], { options_[[opt_id]] <- input[[opt_id]] }) diff --git a/inst/shiny/tlg.yaml b/inst/shiny/tlg.yaml index 25acd3b..0ec7686 100644 --- a/inst/shiny/tlg.yaml +++ b/inst/shiny/tlg.yaml @@ -22,6 +22,9 @@ # # outright or using a special keyword: # - .colnames keyword will pull the choices from the data column names # - .COLUMN_NAME keyword will pull choices from values of a specific column +# There are additional keywords to allow shaping the resulting interface: +# .group_label_N: # will create a label to help visually group related widgets; should be a character +# # string; N should be replaced with an integer to uniquely identify the keyword g_pkconc_ind_lin: is_default: true type: Graph @@ -32,6 +35,7 @@ g_pkconc_ind_lin: link: https://insightsengineering.github.io/tlg-catalog/stable/graphs/pharmacokinetic/pkcg01.html fun: g_pkconc_ind_lin options: + .group_label_1: "General" xvar: type: select label: X axis @@ -50,6 +54,7 @@ g_pkconc_ind_lin: - PCSPEC - PARAM - USUBJID + .group_label_2: "Labels" footnote: type: text label: Footnote @@ -60,6 +65,7 @@ g_pkconc_ind_lin: ylab: type: text label: Y axis label + .group_label_3: "Limits" xmin: type: numeric xmax: diff --git a/inst/shiny/www/style.css b/inst/shiny/www/style.css index d04a0ce..e16d561 100644 --- a/inst/shiny/www/style.css +++ b/inst/shiny/www/style.css @@ -149,4 +149,12 @@ justify-content: space-around; align-items: baseline; margin-bottom: 1em; - } \ No newline at end of file + } + + /* tlg tab */ + h1.tlg-group-label { + font-weight: bold; + font-size: 3rem; + border-bottom: thin solid #337ab7; + border-radius: 0 0 .25em 0; +} \ No newline at end of file From d0eb63b1a09b74d46fdabd7577d8173179e2fb5e Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 12 Dec 2024 10:28:10 +0100 Subject: [PATCH 47/93] chore: added missing deps --- DESCRIPTION | 2 ++ 1 file changed, 2 insertions(+) diff --git a/DESCRIPTION b/DESCRIPTION index 00ecf66..887999e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -31,6 +31,7 @@ Imports: dplyr, DT, forcats, + ggh4x, ggplot2, haven, htmlwidgets, @@ -42,6 +43,7 @@ Imports: reactable.extras, rio, rmarkdown, + scales, shiny, shinyBS, shinyFiles, From f52ee39668f96dfc637404be1cab074bfbf48468 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Fri, 13 Dec 2024 09:01:54 +0100 Subject: [PATCH 48/93] feat: added ability to specify number of plots per page --- inst/shiny/modules/tlg_plot.R | 178 +++++++++++++++++++++------------- 1 file changed, 110 insertions(+), 68 deletions(-) diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R index 9f39f67..1b6a760 100644 --- a/inst/shiny/modules/tlg_plot.R +++ b/inst/shiny/modules/tlg_plot.R @@ -9,18 +9,33 @@ tlg_plot_ui <- function(id) { div(align = "left", shinyjs::disabled(actionButton(ns("previous_page"), "Previous Page"))), div( align = "center", + tags$span( + class = "inline-select-input", + style = "margin-right: 1em;", + tags$span("Plots per page:"), + selectInput( + ns("plots_per_page"), + "", + choices = c(1, 2, 4, 6, 8, 10, "All"), + selected = 1 + ) + ), tags$span( class = "inline-select-input", tags$span("Page "), - uiOutput(ns("select_page_ui")), + selectInput( + inputId = ns("select_page"), + label = "", + choices = "" + ), tags$span(" out of "), - uiOutput(ns("page_number"), inline = TRUE) + uiOutput(ns("page_number"), inline = TRUE), ) ), div(align = "right", actionButton(ns("next_page"), "Next Page")) ), # Plots display # - plotlyOutput(ns("plot")) + uiOutput(ns("plots")) ), column( width = 3, @@ -38,26 +53,38 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { observeEvent(input$previous_page, current_page(current_page() - 1)) observeEvent(input$select_page, current_page(as.numeric(input$select_page))) - #' when data is provided, set page to 1 and render appropriate UI - observeEvent(data(), { - current_page(1) - output$page_number <- renderUI(length(plot_list())) - output$select_page_ui <- renderUI({ - selectInput( - inputId = session$ns("select_page"), - label = "", - choices = seq_len(length(plot_list())), - selected = 1 - ) - }) + #' hold reactive information about the page layout + num_pages <- reactive({ + req(plot_list(), plots_per_page()) + ceiling(length(plot_list()) / plots_per_page()) + }) + + plots_per_page <- reactive({ + if (is.null(input$plots_per_page)) return(NULL) + if (input$plots_per_page == "All") { + isolate(length(plot_list())) + } else { + as.numeric(input$plots_per_page) + } }) #' updates UI responsible for page change - observeEvent(current_page(), { + observeEvent(list(current_page(), num_pages()), { + req(num_pages(), current_page()) shinyjs::toggleState(id = "previous_page", condition = current_page() > 1) - shinyjs::toggleState(id = "next_page", condition = current_page() < length(plot_list())) + shinyjs::toggleState( + id = "next_page", + condition = num_pages() != 1 && current_page() < num_pages() + ) updateSelectInput(session = session, inputId = "select_page", selected = current_page()) }) + observeEvent(plots_per_page(), { + req(num_pages(), plots_per_page()) + current_page(1) + + output$page_number <- renderUI(paste0(num_pages(), ".")) + updateSelectInput(inputId = "select_page", choices = seq_len(num_pages())) + }) #' keeps list of plots to render, with options gathered from the UI and applied plot_list <- reactive({ @@ -71,8 +98,14 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { do.call(render_plot, plot_options) }) - output$plot <- renderPlotly({ - plot_list()[[current_page()]] + output$plots <- renderUI({ + req(plot_list(), plots_per_page(), current_page()) + num_plots <- length(plot_list()) + page_end <- current_page() * plots_per_page() + page_start <- page_end - plots_per_page() + 1 + if (page_end > num_plots) page_end <- num_plots + + plot_list()[page_start:page_end] }) #' holds options gathered from UI widgets @@ -88,58 +121,67 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { options_[[opt_id]] <- input[[opt_id]] }) - label <- if (is.null(opt_def$label)) opt_id else opt_def$label + create_edit_widget(opt_def, opt_id) + }) - switch( - opt_def$type, - text = { - textInput( - session$ns(opt_id), - label = label, - value = opt_def$default - ) - }, - numeric = { - numericInput( - session$ns(opt_id), - label = label, - value = opt_def$default - ) - }, - select = { - choices <- { - if (isTRUE(opt_def$choices == ".colnames")) { - names(data()) - } else if (length(opt_def$choices) == 1 && grepl("^\\.", opt_def$choices)) { - unique(data()[, sub("^\\.", "", opt_def$choices)]) - } else { - opt_def$choices - } - } + output$options <- renderUI(option_widgets) + }) +} - selected <- { - if (!is.null(opt_def$default)) { - if (opt_def$default == ".all") { - choices - } else { - opt_def$default - } - } else { - "" - } - } +#' Creates editing widget of appropriate type. +#' @param opt_def Definition of the option +#' @param opt_id Id of the option +#' @param session Session object for namespacing the widgets +#' @returns Shiny widget with appropriate type, label and options +create_edit_widget <- function(opt_def, opt_id, session = shiny::getDefaultReactiveDomain()) { + label <- if (is.null(opt_def$label)) opt_id else opt_def$label + + switch( + opt_def$type, + text = { + textInput( + session$ns(opt_id), + label = label, + value = opt_def$default + ) + }, + numeric = { + numericInput( + session$ns(opt_id), + label = label, + value = opt_def$default + ) + }, + select = { + choices <- { + if (isTRUE(opt_def$choices == ".colnames")) { + names(data()) + } else if (length(opt_def$choices) == 1 && grepl("^\\.", opt_def$choices)) { + unique(data()[, sub("^\\.", "", opt_def$choices)]) + } else { + opt_def$choices + } + } - selectInput( - session$ns(opt_id), - label = label, - selected = selected, - choices = c("", choices), - multiple = isTRUE(opt_def$multiple) - ) + selected <- { + if (!is.null(opt_def$default)) { + if (opt_def$default == ".all") { + choices + } else { + opt_def$default + } + } else { + "" } - ) - }) + } - output$options <- renderUI(option_widgets) - }) + selectInput( + session$ns(opt_id), + label = label, + selected = selected, + choices = c("", choices), + multiple = isTRUE(opt_def$multiple) + ) + } + ) } \ No newline at end of file From 86203212a4b0aee00d56cc463bad799bd8acb485 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Mon, 16 Dec 2024 08:15:26 +0100 Subject: [PATCH 49/93] chore: set all plots on page as default --- inst/shiny/modules/tlg_plot.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R index 1b6a760..326d07c 100644 --- a/inst/shiny/modules/tlg_plot.R +++ b/inst/shiny/modules/tlg_plot.R @@ -16,8 +16,7 @@ tlg_plot_ui <- function(id) { selectInput( ns("plots_per_page"), "", - choices = c(1, 2, 4, 6, 8, 10, "All"), - selected = 1 + choices = c("All", 1, 2, 4, 6, 8, 10) ) ), tags$span( From 922435a7631a7f40cd14e93c2d79d92cafb69fc8 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Mon, 16 Dec 2024 08:23:30 +0100 Subject: [PATCH 50/93] fix: R CMD check --- R/g_pkconc_ind.R | 53 +------------------------------------------- man/filter_breaks.Rd | 14 ++++-------- man/pkcg01.Rd | 18 --------------- 3 files changed, 5 insertions(+), 80 deletions(-) diff --git a/R/g_pkconc_ind.R b/R/g_pkconc_ind.R index eee2b8d..4b507a0 100644 --- a/R/g_pkconc_ind.R +++ b/R/g_pkconc_ind.R @@ -52,7 +52,7 @@ g_pkconc_ind_log <- function(data, ...) { #' \dontrun { #' adpc <- read.csv("inst/shiny/data/DummyRO_ADNCA.csv") #' attr(adpc[["AFRLT"]], "label") <- "Actual time from first dose" -#' attr(adpc[["AVAL"]], "label") <- "Analysis val +#' attr(adpc[["AVAL"]], "label") <- "Analysis val" #' #' plots_lin <- pkcg01(adpc = adpc, xmax = 1) #' plots_log <- pkcg01(adpc = adpc, color_var = "USUBJID", scale = "LOG) @@ -297,54 +297,3 @@ add_figure_details <- function( ) %>% ungroup() } - -#' Filter Breaks for X-Axis -#' -#' Filters X-axis for consecutive breaks with at least the specified distance. -#' -#' @param x_breaks A numeric vector of x-axis breaks. -#' @param plot A ggplot object used to extract plot dimensions and scales. -#' @param min_cm_distance A numeric of the minimum distance between breaks. -#' @returns A numeric vector of filtered x-axis breaks. -#' @importFrom ggplot2 ggplot_build ggplot_gtable -#' @importFrom grid convertUnit -#' @author Gerardo Rodriguez -filter_breaks <- function(x_breaks = NA, plot = plot, min_cm_distance = 0.5) { - x_breaks <- unique(na.omit(sort(x_breaks))) - plot_build <- ggplot_build(plot) - plot_table <- ggplot_gtable(plot_build) - - # Extract x-axis scale information - x_scale <- plot_build$layout$panel_params[[1]]$x.range - - # Identify the panel grob - panel_index <- which(sapply(plot_table$grobs, \(x) grepl("panel", x$name))) - - if (length(panel_index) == 0) { - stop("Error: Panel grob not found.") - } - panel <- plot_table$grobs[[panel_index]] - - # Extract the panel border grob to get the width - panel_border <- panel$children[[ - which(sapply(panel$children, \(x) grepl("panel.border", x$name))) - ]] - - # Convert panel width to cm - panel_width_cm <- grid::convertUnit(panel_border$width, unitTo = "cm", valueOnly = TRUE) - - # Filter only breaks that satisfy the minimum distance - filt_breaks <- x_breaks[1] - - for (i in 2:length(x_breaks)) { - # Take latest selected break and calculate its distance - b0 <- filt_breaks[length(filt_breaks)] - bdist <- (x_breaks[i] - b0) / diff(x_scale) * panel_width_cm - - if (bdist >= min_cm_distance) { - filt_breaks <- c(filt_breaks, x_breaks[i]) - } - } - - filt_breaks -} \ No newline at end of file diff --git a/man/filter_breaks.Rd b/man/filter_breaks.Rd index 3bb7930..3514856 100644 --- a/man/filter_breaks.Rd +++ b/man/filter_breaks.Rd @@ -1,28 +1,22 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/filter_breaks.R, R/g_pkconc_ind.R +% Please edit documentation in R/filter_breaks.R \name{filter_breaks} \alias{filter_breaks} \title{Filter Breaks for X-Axis} \usage{ -filter_breaks(x_breaks = NA, plot = plot, min_cm_distance = 0.5) - -filter_breaks(x_breaks = NA, plot = plot, min_cm_distance = 0.5) +filter_breaks(breaks = NA, plot = plot, min_cm_distance = 0.5, axis = "x") } \arguments{ -\item{x_breaks}{A numeric vector of x-axis breaks.} - \item{plot}{A ggplot object used to extract plot dimensions and scales.} \item{min_cm_distance}{A numeric of the minimum distance between breaks.} + +\item{x_breaks}{A numeric vector of x-axis breaks.} } \value{ -A numeric vector of filtered x-axis breaks. - A numeric vector of filtered x-axis breaks. } \description{ -Filters X-axis for consecutive breaks with at least the specified distance. - Filters X-axis for consecutive breaks with at least the specified distance. } \author{ diff --git a/man/pkcg01.Rd b/man/pkcg01.Rd index 7987d25..b05c603 100644 --- a/man/pkcg01.Rd +++ b/man/pkcg01.Rd @@ -74,24 +74,6 @@ A list of ggplot objects for each unique group. } \description{ This function generates a list of ggplots for PK concentration-time profiles. -} -\examples{ -\dontrun { - adpc <- read.csv("inst/shiny/data/DummyRO_ADNCA.csv") - attr(adpc[["AFRLT"]], "label") <- "Actual time from first dose" - attr(adpc[["AVAL"]], "label") <- "Analysis val - - plots_lin <- pkcg01(adpc = adpc, xmax = 1) - plots_log <- pkcg01(adpc = adpc, color_var = "USUBJID", scale = "LOG) - plots_sbs <- pkcg01( - adpc = adpc, - color_var = "USUBJID", - xbreaks_var = "NFRLT", - xmin = 100, xmax = 1000, - scale = "SBS" - ) -} - } \author{ Gerardo Rodriguez From bb7ec9270661ce3facaff6d0c30da55947da9700 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Mon, 16 Dec 2024 08:24:47 +0100 Subject: [PATCH 51/93] fix: invalid arguments to filter_breaks() --- R/g_pkconc_ind.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/g_pkconc_ind.R b/R/g_pkconc_ind.R index 4b507a0..99fc2f7 100644 --- a/R/g_pkconc_ind.R +++ b/R/g_pkconc_ind.R @@ -157,7 +157,7 @@ pkcg01 <- function( scale_x_continuous( guide = guide_axis(n.dodge = 1), breaks = filter_breaks( - x_breaks = plot_data[[xbreaks_var]], + plot_data[[xbreaks_var]], min_cm_distance = xbreaks_mindist, plot = plot ), From c7a6c73446473554d8a4255bc6ec6168046da33c Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Mon, 16 Dec 2024 08:25:05 +0100 Subject: [PATCH 52/93] refactor: changed order of plot widgets --- inst/shiny/modules/tlg_plot.R | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R index 326d07c..a427db2 100644 --- a/inst/shiny/modules/tlg_plot.R +++ b/inst/shiny/modules/tlg_plot.R @@ -6,12 +6,11 @@ tlg_plot_ui <- function(id) { width = 9, fluidRow( class = "plot-widgets-container", - div(align = "left", shinyjs::disabled(actionButton(ns("previous_page"), "Previous Page"))), div( - align = "center", + align = "left", tags$span( class = "inline-select-input", - style = "margin-right: 1em;", + style = "margin-right: 5em;", tags$span("Plots per page:"), selectInput( ns("plots_per_page"), @@ -19,6 +18,10 @@ tlg_plot_ui <- function(id) { choices = c("All", 1, 2, 4, 6, 8, 10) ) ), + shinyjs::disabled(actionButton(ns("previous_page"), "Previous Page")) + ), + div( + align = "center", tags$span( class = "inline-select-input", tags$span("Page "), From bf3cd101bda1acdead3cb58bd8eb197b6d217a63 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Mon, 16 Dec 2024 08:45:19 +0100 Subject: [PATCH 53/93] feat: option to reset widgets to defaults --- inst/shiny/modules/tlg_plot.R | 16 +++++++++++++++- inst/shiny/www/style.css | 24 ++++++++++++++++++------ 2 files changed, 33 insertions(+), 7 deletions(-) diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R index a427db2..acd0615 100644 --- a/inst/shiny/modules/tlg_plot.R +++ b/inst/shiny/modules/tlg_plot.R @@ -2,6 +2,7 @@ tlg_plot_ui <- function(id) { ns <- NS(id) fluidRow( + class = "tlg-plot-module", column( width = 9, fluidRow( @@ -41,7 +42,7 @@ tlg_plot_ui <- function(id) { ), column( width = 3, - uiOutput(ns("options")) + uiOutput(ns("options"), class = "plot-options-container") ) ) } @@ -110,6 +111,11 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { plot_list()[page_start:page_end] }) + #' resets the options to defaults + observeEvent(input$reset_widgets, { + purrr::walk(names(options), shinyjs::reset) + }) + #' holds options gathered from UI widgets options_ <- reactiveValues() @@ -126,6 +132,14 @@ tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { create_edit_widget(opt_def, opt_id) }) + option_widgets <- tagList( + actionButton( + inputId = session$ns("reset_widgets"), + label = "Reset to defaults" + ), + option_widgets + ) + output$options <- renderUI(option_widgets) }) } diff --git a/inst/shiny/www/style.css b/inst/shiny/www/style.css index e16d561..cd1b430 100644 --- a/inst/shiny/www/style.css +++ b/inst/shiny/www/style.css @@ -137,6 +137,7 @@ } } +/* custom inline selection module */ .inline-select-input > div, .inline-select-input > div > div { width: 5em !important; @@ -144,7 +145,9 @@ display: inline-block !important; } -.plot-widgets-container { + +.tlg-plot-module { + .plot-widgets-container { display: flex; justify-content: space-around; align-items: baseline; @@ -153,8 +156,17 @@ /* tlg tab */ h1.tlg-group-label { - font-weight: bold; - font-size: 3rem; - border-bottom: thin solid #337ab7; - border-radius: 0 0 .25em 0; -} \ No newline at end of file + font-weight: bold; + font-size: 3rem; + border-bottom: thin solid #337ab7; + border-radius: 0 0 .25em 0; + } + + .plot-options-container { + button { + width: 75%; + margin-left: 15%; + margin-top: 1em; + } + } +} From b7694da247d75df62bd5d9b686f5c82c3ee0f10d Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Mon, 16 Dec 2024 09:00:24 +0100 Subject: [PATCH 54/93] feat: auto change tabs after submitting order; added logs --- inst/shiny/modules/tab_tlg.R | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) diff --git a/inst/shiny/modules/tab_tlg.R b/inst/shiny/modules/tab_tlg.R index 06eb2df..61a2970 100644 --- a/inst/shiny/modules/tab_tlg.R +++ b/inst/shiny/modules/tab_tlg.R @@ -4,6 +4,7 @@ tab_tlg_ui <- function(id) { ns <- NS(id) tabsetPanel( + id = ns("tlg_tabs"), tabPanel( "Order details", actionButton(ns("add_tlg"), "Add TLG"), @@ -64,9 +65,9 @@ tab_tlg_ui <- function(id) { tab_tlg_server <- function(id, data) { moduleServer(id, function(input, output, session) { - ns <- session$ns + log_trace("{session$ns(id)}: Attaching server.") - # Make available the CSV file with the TLG list and available links to NEST + #' Load TLG orders definitions tlg_order <- reactiveVal({ purrr::map_dfr(.TLG_DEFINITIONS, ~ dplyr::tibble( Selection = .x$is_default, @@ -101,6 +102,7 @@ tab_tlg_server <- function(id, data) { # Render the TLG list for the user's inspection output$selected_tlg_table <- DT::renderDT({ + log_trace("Rendering TLG table.") datatable( elementId = "selected_tlg_datatable", class = "table table-striped table-bordered", @@ -229,8 +231,11 @@ tab_tlg_server <- function(id, data) { }) # When the user submits the TLG order... - observeEvent(list(input$submit_tlg_order, input$submit_tlg_order_alt), { + observeEvent(list(input$submit_tlg_order, input$submit_tlg_order_alt), ignoreInit = TRUE, { + log_trace("Submitting TLG order...") + tlg_order_filt <- tlg_order()[tlg_order()$Selection, ] + log_debug("Submitted TLGs:\n", paste0("* ", tlg_order_filt$Description, collapse = "\n")) if (sum(tlg_order_filt$Type == "Table") > 0) { updateRadioButtons( @@ -280,6 +285,11 @@ tab_tlg_server <- function(id, data) { output$graphs <- renderUI({ do.call(navlistPanel, panels) }) + + #' change tab to first populated tab + #' NOTE: currently only plots implemented, will change to Graphs tab + #' TODO: when Tables and/or Listings are implemented, detect which tab is populated and adjust + updateTabsetPanel(inputId = "tlg_tabs", selected = "Graphs") }) }) } From bca9858c7c516cd5589f961262263c9f03304f38 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Mon, 16 Dec 2024 09:23:16 +0100 Subject: [PATCH 55/93] refactor: created global data reactive for easy access across modules --- inst/shiny/modules/tab_tlg.R | 6 ++++-- inst/shiny/modules/tlg_plot.R | 8 +++++--- inst/shiny/server.R | 7 ++++++- 3 files changed, 15 insertions(+), 6 deletions(-) diff --git a/inst/shiny/modules/tab_tlg.R b/inst/shiny/modules/tab_tlg.R index 61a2970..74949c4 100644 --- a/inst/shiny/modules/tab_tlg.R +++ b/inst/shiny/modules/tab_tlg.R @@ -63,10 +63,12 @@ tab_tlg_ui <- function(id) { ) } -tab_tlg_server <- function(id, data) { +tab_tlg_server <- function(id) { moduleServer(id, function(input, output, session) { log_trace("{session$ns(id)}: Attaching server.") + data <- session$userData$data + #' Load TLG orders definitions tlg_order <- reactiveVal({ purrr::map_dfr(.TLG_DEFINITIONS, ~ dplyr::tibble( @@ -271,7 +273,7 @@ tab_tlg_server <- function(id, data) { g_def <- .TLG_DEFINITIONS[[g_id]] if (exists(g_def$fun)) { - tlg_plot_server(g_id, get(g_def$fun), g_def$options, data) + tlg_plot_server(g_id, get(g_def$fun), g_def$options) tlg_plot_ui(session$ns(g_id)) } else { tags$div("Plot not implemented yet") diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R index acd0615..c13ec9b 100644 --- a/inst/shiny/modules/tlg_plot.R +++ b/inst/shiny/modules/tlg_plot.R @@ -47,8 +47,10 @@ tlg_plot_ui <- function(id) { ) } -tlg_plot_server <- function(id, render_plot, options = NULL, data = NULL) { +tlg_plot_server <- function(id, render_plot, options = NULL) { moduleServer(id, function(input, output, session) { + data <- session$userData$data + current_page <- reactiveVal(1) #' updating current page based on user input @@ -171,9 +173,9 @@ create_edit_widget <- function(opt_def, opt_id, session = shiny::getDefaultReact select = { choices <- { if (isTRUE(opt_def$choices == ".colnames")) { - names(data()) + names(session$userData$data()) } else if (length(opt_def$choices) == 1 && grepl("^\\.", opt_def$choices)) { - unique(data()[, sub("^\\.", "", opt_def$choices)]) + unique(session$userData$data()[, sub("^\\.", "", opt_def$choices)]) } else { opt_def$choices } diff --git a/inst/shiny/server.R b/inst/shiny/server.R index ad5986b..4535fc5 100644 --- a/inst/shiny/server.R +++ b/inst/shiny/server.R @@ -5,11 +5,16 @@ function(input, output, session) { # DATA ---- data <- tab_data_server("data") + + #' Create global data object. This is accessible by all modules, without the need to pass + #' data reactive directly. + session$userData$data <- reactive(data()) + # NCA ---- source(system.file("shiny/tabs/nca.R", package = "aNCA"), local = TRUE) # OUTPUT ---- source(system.file("shiny/tabs/outputs.R", package = "aNCA"), local = TRUE) # TLG - tab_tlg_server("tlg", data) + tab_tlg_server("tlg") } From f63dda6c80cd5d8e5f5e6f44820eb0eeffea7c08 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Mon, 16 Dec 2024 09:28:31 +0100 Subject: [PATCH 56/93] chore: updated definition for g_pkconc_ind_lin plot --- inst/shiny/tlg.yaml | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/inst/shiny/tlg.yaml b/inst/shiny/tlg.yaml index 0ec7686..137b398 100644 --- a/inst/shiny/tlg.yaml +++ b/inst/shiny/tlg.yaml @@ -54,6 +54,12 @@ g_pkconc_ind_lin: - PCSPEC - PARAM - USUBJID + # TODO: splitting variable + color_var: + type: select + label: "Color variable" + choices: .colnames + .group_label_2: "Labels" footnote: type: text @@ -61,10 +67,18 @@ g_pkconc_ind_lin: xlab: type: text label: X axis label - default: "Test default label" ylab: type: text label: Y axis label + xbreaks_var: + type: select + label: "X ticks" + choices: .colnames + default: "NFRLT" + color_var_label: + type: text + label: Color variable label + .group_label_3: "Limits" xmin: type: numeric From caf1e4752ed5191e3129c314cef300e2021e7d57 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Mon, 16 Dec 2024 09:48:03 +0100 Subject: [PATCH 57/93] feat: added templating options --- inst/shiny/modules/tab_tlg.R | 27 ++++++++++++++++++++++++++- inst/shiny/tlg.yaml | 34 ++++++++-------------------------- 2 files changed, 34 insertions(+), 27 deletions(-) diff --git a/inst/shiny/modules/tab_tlg.R b/inst/shiny/modules/tab_tlg.R index 74949c4..ff1df1d 100644 --- a/inst/shiny/modules/tab_tlg.R +++ b/inst/shiny/modules/tab_tlg.R @@ -1,4 +1,29 @@ -.TLG_DEFINITIONS <- yaml::read_yaml(system.file("shiny/tlg.yaml", package = "aNCA")) +.TLG_DEFINITIONS <- { + defs <- yaml::read_yaml(system.file("shiny/tlg.yaml", package = "aNCA")) + + defs <- purrr::imap(defs, \(opt_def, opt_id) { + if ("template" %in% names(opt_def)) { + template_def <- defs[[opt_def$template]] + + for (d in names(opt_def)) { + if (d == "template") next + + if (d == "options") { + for (o in names(opt_def$options)) { + template_def$options[[o]] <- opt_def$options[[o]] + } + } else { + template_def[[d]] <- opt_def[[d]] + } + } + + opt_def <- template_def + } + + opt_def + }) |> + setNames(defs) +} tab_tlg_ui <- function(id) { ns <- NS(id) diff --git a/inst/shiny/tlg.yaml b/inst/shiny/tlg.yaml index 137b398..7aafd03 100644 --- a/inst/shiny/tlg.yaml +++ b/inst/shiny/tlg.yaml @@ -24,13 +24,17 @@ # - .COLUMN_NAME keyword will pull choices from values of a specific column # There are additional keywords to allow shaping the resulting interface: # .group_label_N: # will create a label to help visually group related widgets; should be a character -# # string; N should be replaced with an integer to uniquely identify the keyword +# # string; N should be replaced with an integer to uniquely identify the keyword +# +# template: # You can also specify template definitions. This is a character string with id of another TLG definition. +# # All options will be copied over from template id. Any provided parameters will be a) overwritten if existing +# # in the template or b) added as new. g_pkconc_ind_lin: is_default: true type: Graph dataset: ADPC pkid: pkcg01 - label: pkcg01 - linear + label: "pkcg01 - linear" description: "Individual plots of concentrations vs. time (one plot per patient/subject) with linear scale" link: https://insightsengineering.github.io/tlg-catalog/stable/graphs/pharmacokinetic/pkcg01.html fun: g_pkconc_ind_lin @@ -89,29 +93,7 @@ g_pkconc_ind_lin: ymax: type: numeric g_pkconc_ind_log: - is_default: true - type: Graph - dataset: ADPC - pkid: pkcg01 + template: g_pkconc_ind_lin label: pkcg01 - log description: "Individual plots of concentrations vs. time (one plot per patient/subject) with log10 scale" - link: https://insightsengineering.github.io/tlg-catalog/stable/graphs/pharmacokinetic/pkcg01.html - fun: g_pkconc_ind_log - options: - footnote: - type: text - label: Footnote - xlab: - type: text - label: X axis label - ylab: - type: text - label: Y axis label - xmin: - type: numeric - xmax: - type: numeric - ymin: - type: numeric - ymax: - type: numeric + fun: g_pkconc_ind_log \ No newline at end of file From 8ee522df8c2e000dab02e21f090f493727c6b943 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Mon, 16 Dec 2024 14:12:28 +0100 Subject: [PATCH 58/93] refactor: rendering widgets, added debounce --- inst/shiny/modules/tlg_plot.R | 41 ++++++++++++++++------------------- 1 file changed, 19 insertions(+), 22 deletions(-) diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R index c13ec9b..d981a6a 100644 --- a/inst/shiny/modules/tlg_plot.R +++ b/inst/shiny/modules/tlg_plot.R @@ -93,7 +93,7 @@ tlg_plot_server <- function(id, render_plot, options = NULL) { #' keeps list of plots to render, with options gathered from the UI and applied plot_list <- reactive({ - plot_options <- purrr::list_modify(list(data = data()), !!!reactiveValuesToList(options_)) + plot_options <- purrr::list_modify(list(data = data()), !!!options_()) purrr::iwalk(plot_options, \(value, name) { if (isTRUE(value %in% c(NULL, "", 0))) @@ -119,30 +119,23 @@ tlg_plot_server <- function(id, render_plot, options = NULL) { }) #' holds options gathered from UI widgets - options_ <- reactiveValues() + options_ <- reactive({ + lapply(names(options), \(opt_id) input[[opt_id]]) |> + setNames(names(options)) |> + purrr::keep(\(x) !is.null(x)) + }) |> + shiny::debounce(750) #' creates widgets responsible for custimizing the plots - option_widgets <- purrr::imap(options, function(opt_def, opt_id) { - if (grepl(".group_label", opt_id)) { - return(tags$h1(opt_def, class = "tlg-group-label")) - } - - observeEvent(input[[opt_id]], { - options_[[opt_id]] <- input[[opt_id]] - }) - - create_edit_widget(opt_def, opt_id) + output$options <- renderUI({ + tagList( + actionButton( + inputId = session$ns("reset_widgets"), + label = "Reset to defaults" + ), + purrr::imap(options, create_edit_widget) + ) }) - - option_widgets <- tagList( - actionButton( - inputId = session$ns("reset_widgets"), - label = "Reset to defaults" - ), - option_widgets - ) - - output$options <- renderUI(option_widgets) }) } @@ -152,6 +145,10 @@ tlg_plot_server <- function(id, render_plot, options = NULL) { #' @param session Session object for namespacing the widgets #' @returns Shiny widget with appropriate type, label and options create_edit_widget <- function(opt_def, opt_id, session = shiny::getDefaultReactiveDomain()) { + if (grepl(".group_label", opt_id)) { + return(tags$h1(opt_def, class = "tlg-group-label")) + } + label <- if (is.null(opt_def$label)) opt_id else opt_def$label switch( From e618aa39c1e2a9ee0582e0fe629e27d63a7cce49 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Mon, 16 Dec 2024 14:12:52 +0100 Subject: [PATCH 59/93] refactor: removed yvar from pkcg01 definition --- inst/shiny/tlg.yaml | 4 ---- 1 file changed, 4 deletions(-) diff --git a/inst/shiny/tlg.yaml b/inst/shiny/tlg.yaml index 7aafd03..c1cb6eb 100644 --- a/inst/shiny/tlg.yaml +++ b/inst/shiny/tlg.yaml @@ -44,10 +44,6 @@ g_pkconc_ind_lin: type: select label: X axis choices: .colnames - yvar: - type: select - label: Y axis - choices: .colnames plotgroup_vars: type: select label: "Grouping variables" From 6330c691a13945f0a223427f2855efcf40384e4c Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Mon, 16 Dec 2024 15:18:57 +0100 Subject: [PATCH 60/93] refactor: migrated UI to bslib --- inst/shiny/modules/tab_tlg.R | 62 +++++------------------------ inst/shiny/modules/tlg_plot.R | 73 ++++++++++++++++------------------- inst/shiny/tlg.yaml | 2 +- inst/shiny/www/style.css | 19 ++++++++- 4 files changed, 63 insertions(+), 93 deletions(-) diff --git a/inst/shiny/modules/tab_tlg.R b/inst/shiny/modules/tab_tlg.R index 7afe6b6..7c7bee3 100644 --- a/inst/shiny/modules/tab_tlg.R +++ b/inst/shiny/modules/tab_tlg.R @@ -28,9 +28,9 @@ tab_tlg_ui <- function(id) { ns <- NS(id) - tabsetPanel( + navset_pill( id = ns("tlg_tabs"), - tabPanel( + nav_panel( "Order details", actionButton(ns("add_tlg"), "Add TLG"), actionButton(ns("remove_tlg"), "Remove TLG"), @@ -38,53 +38,9 @@ tab_tlg_ui <- function(id) { DTOutput(ns("selected_tlg_table")), actionButton(ns("submit_tlg_order_alt"), "Submit Order Details") ), - tabPanel( - "Tables", - fluidRow( - column( - 2, # Left column for plot selection - radioButtons( - inputId = ns("buttons_Tables"), - label = "Choose Table\n", - choices = "" - ) - ), - column( - 6, # Middle column for plot output - h4("Table to display"), - plotOutput(ns("plot_Tables")) - ), - column( - 2, # Right column for plot customization inputs - h4("Inputs with selected vals linked to downloadable obj (i.e, tlg_order())"), - textInput(ns("footnote_Tables"), label = "Footnote") - ) - ) - ), - tabPanel( - "Listings", - fluidRow( - column( - 2, # Left column for plot selection - radioButtons( - inputId = ns("buttons_Listings"), - label = "Choose List\n", - choices = "" - ) - ), - column( - 6, # Middle column for plot output - h4("Listing to display"), - plotOutput(ns("plot_Listings")) - ), - column( - 2, # Right column for plot customization inputs - h4("Inputs with selected vals linked to downloadable obj (i.e, tlg_order())"), - textInput(ns("footnote_Listings"), label = "Footnote") - ) - ) - ), - tabPanel("Graphs", uiOutput(ns("graphs"))) + nav_panel("Tables", "To be added"), + nav_panel("Listings", "To be added"), + nav_panel("Graphs", uiOutput(ns("graphs"), class = "tlg-plot-module")) ) } @@ -306,18 +262,20 @@ tab_tlg_server <- function(id) { } } - tabPanel(g_def$label, plot_ui) + nav_panel(g_def$label, plot_ui) }) panels$"widths" <- c(2, 10) output$graphs <- renderUI({ - do.call(navlistPanel, panels) + do.call(navset_pill_list, panels) }) #' change tab to first populated tab #' NOTE: currently only plots implemented, will change to Graphs tab #' TODO: when Tables and/or Listings are implemented, detect which tab is populated and adjust - updateTabsetPanel(inputId = "tlg_tabs", selected = "Graphs") + #' FIXME: for some reason this does not work with bslib + nav_select(id = "tlg_tabs", selected = "Graphs") + updateTabsetPanel(session, "tlg_tabs", selected = "Graphs") }) }) } diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R index d981a6a..5e426b0 100644 --- a/inst/shiny/modules/tlg_plot.R +++ b/inst/shiny/modules/tlg_plot.R @@ -1,49 +1,44 @@ tlg_plot_ui <- function(id) { ns <- NS(id) - fluidRow( - class = "tlg-plot-module", - column( - width = 9, - fluidRow( - class = "plot-widgets-container", - div( - align = "left", - tags$span( - class = "inline-select-input", - style = "margin-right: 5em;", - tags$span("Plots per page:"), - selectInput( - ns("plots_per_page"), - "", - choices = c("All", 1, 2, 4, 6, 8, 10) - ) - ), - shinyjs::disabled(actionButton(ns("previous_page"), "Previous Page")) - ), - div( - align = "center", - tags$span( - class = "inline-select-input", - tags$span("Page "), - selectInput( - inputId = ns("select_page"), - label = "", - choices = "" - ), - tags$span(" out of "), - uiOutput(ns("page_number"), inline = TRUE), + layout_sidebar( + sidebar = sidebar( + position = "right", + uiOutput(ns("options"), class = "plot-options-container") + ), + div( + class = "plot-widgets-container", + div( + align = "left", + tags$span( + class = "inline-select-input", + style = "margin-right: 5em;", + tags$span("Plots per page:"), + selectInput( + ns("plots_per_page"), + "", + choices = c("All", 1, 2, 4, 6, 8, 10) ) ), - div(align = "right", actionButton(ns("next_page"), "Next Page")) + shinyjs::disabled(actionButton(ns("previous_page"), "Previous Page")) ), - # Plots display # - uiOutput(ns("plots")) + div( + align = "center", + tags$span( + class = "inline-select-input", + tags$span("Page "), + selectInput( + inputId = ns("select_page"), + label = "", + choices = "" + ), + tags$span(" out of "), + uiOutput(ns("page_number"), inline = TRUE), + ) + ), + div(align = "right", actionButton(ns("next_page"), "Next Page")) ), - column( - width = 3, - uiOutput(ns("options"), class = "plot-options-container") - ) + uiOutput(ns("plots")) ) } diff --git a/inst/shiny/tlg.yaml b/inst/shiny/tlg.yaml index c1cb6eb..b68262c 100644 --- a/inst/shiny/tlg.yaml +++ b/inst/shiny/tlg.yaml @@ -92,4 +92,4 @@ g_pkconc_ind_log: template: g_pkconc_ind_lin label: pkcg01 - log description: "Individual plots of concentrations vs. time (one plot per patient/subject) with log10 scale" - fun: g_pkconc_ind_log \ No newline at end of file + fun: g_pkconc_ind_log diff --git a/inst/shiny/www/style.css b/inst/shiny/www/style.css index cd1b430..e3ca096 100644 --- a/inst/shiny/www/style.css +++ b/inst/shiny/www/style.css @@ -147,6 +147,13 @@ .tlg-plot-module { + margin-top: 1em; + + /* Well containing tabs for each tlg */ + div.well { + height: min-content; + } + .plot-widgets-container { display: flex; justify-content: space-around; @@ -157,9 +164,10 @@ /* tlg tab */ h1.tlg-group-label { font-weight: bold; - font-size: 3rem; + font-size: 2rem; border-bottom: thin solid #337ab7; border-radius: 0 0 .25em 0; + margin-top: 0.75em; } .plot-options-container { @@ -167,6 +175,15 @@ width: 75%; margin-left: 15%; margin-top: 1em; + padding: 0.75em 0 0.75em 0; + } + + .form-group.shiny-input-container { + margin-bottom: 0.5em; + + label { + margin: 0; + } } } } From f1febc6f75dc4c5ab29666b31d308ad1482c510c Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Mon, 16 Dec 2024 15:54:37 +0100 Subject: [PATCH 61/93] docs: added documentation for creating tlgs --- .github/contributing/adding-tlg.md | 64 ++++++++++++++++++++++++++++++ CONTRIBUTING.md | 7 +++- inst/shiny/tlg.yaml | 33 +-------------- 3 files changed, 72 insertions(+), 32 deletions(-) create mode 100644 .github/contributing/adding-tlg.md diff --git a/.github/contributing/adding-tlg.md b/.github/contributing/adding-tlg.md new file mode 100644 index 0000000..74807b5 --- /dev/null +++ b/.github/contributing/adding-tlg.md @@ -0,0 +1,64 @@ +# Adding new Tables, Listing and Graphs +In order to add new TLGs, two things are needed: +### TLG definition +Specified in [tlg.yaml](../../inst/shiny/tlg.yaml) file. Entry in that file is responsible for providing some metadata regarding the TLG (like name, descriptions, links), a function reference for creating the resulting TLG and options, taken as arguments by the generating function, that allow for quick and easy definition of widgets to be rendered in the application UI. This then allows the user to customize plots in accordance to their needs. + +### `R` function +The code that creates the actual results. + +## Listings +Currently not implemented. + +## Tables +Currently not implemented + +## Graphs +### yaml +The `Graph` entry should have the following format: + ```yaml +# unique identifier for given entry +id: + # true / false whether TLG should be included as default + is_default: + # type of the TLG, in this case must be Graph + type: + # name of the dataset + dataset: + # standarized id of the TLG, e.g. pkcg01 + pkid: + # short label to be displayed as tab name + label: + # longer descriptions, to be displayed in the order table + description: + # link to the documentation of the TLG + link: + # name of the function exported by the package, responsible for generating TLG, must return a list of plots to be displayed + fun: + # options that can be passed as arguments to the function + options: + # option id, the same as the argument that is passed to the rendering function, must be unique in the scope of the TLG entry + optid: + # type of the option/widget, one of: text, numeric, select + type: + # label to be displayed in the editing widget + label: + # default value to be provided in the field; + # if provided, will overwrite function argument defaults; + # if left empty, function defaults will be applied; + # if type is 'select', '.all' keyword can be applied to select all choices; + default: + # applicable to 'select' type, whether to allow for multiple values to be selected + multiple: + # applicable to 'select' type, choices to pick from the dropdown, either specified outright or using a special keyword: + # - '.colnames' keyword will pull the choices from the data column names + # - '.COLUMN_NAME' keyword will pull choices from values of a specific column + choices: + # will create a label to help visually group related widgets; should be a character string; N should be replaced with an integer to uniquely identify the keyword + .group_label_N: + + template: + # You can also specify template definitions. This is a character string with id of another TLG definition. All options will be copied over from template id. Any provided parameters will be a) overwritten if existing in the template or b) added as new. +``` + +### function +Function should be defined within `aNCA` package and accept at least a `data` argument for providing results to be plotted. Should return a list of plots (might be just one plot). \ No newline at end of file diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 0402f32..aea46ea 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -73,4 +73,9 @@ Each pull request must be accepted by at least one reviewer before it can be mer When the change is done, pull request is open and the description is filled, please move your issue from **In Progress** to **Needs review** status, so it can be picked up by a reviewer. From this point it is up to the contributor and the person validating the change to work out any kinks and lead to merging the changes. #### For reviewers -When reviewing a pull request, please do try to follow the [conventional comments](https://conventionalcomments.org/) guidelines. Ideas and labels described in that convention can be very helpful in getting your thoughts across and facilitate meaningful cooperation. That said, they are not applicable in every circumstance and you are free to do whatever you feel is suitable, as long as it aims to provide valid discussion. \ No newline at end of file +When reviewing a pull request, please do try to follow the [conventional comments](https://conventionalcomments.org/) guidelines. Ideas and labels described in that convention can be very helpful in getting your thoughts across and facilitate meaningful cooperation. That said, they are not applicable in every circumstance and you are free to do whatever you feel is suitable, as long as it aims to provide valid discussion. + +# In-depth guides +Here are some useful links with in-depth documentation regarding specific parts of the pacakage and how to utilise in-build tools to extend the capabilities of the application: + +- [Adding TLGs](.github/contributing/adding-tlg.md) \ No newline at end of file diff --git a/inst/shiny/tlg.yaml b/inst/shiny/tlg.yaml index b68262c..ccb5768 100644 --- a/inst/shiny/tlg.yaml +++ b/inst/shiny/tlg.yaml @@ -1,34 +1,5 @@ -# Configuration file containing TLG definitions. Each TLG should be a separate entry, with unique ID. -# The TLG entry should have the following format: -# id: -# is_default: # true / false whether TLG should be included as default -# type: # Graph / List / Table -# dataset: # name of the dataset -# pkid: # standarized id of the TLG -# label: # short label to display as tab name -# description: # longer descriptions, to be displayed in the order table -# link: # link to the documentation of the TLG -# fun: # name of the function exported by the package, responsible for generating TLG, must -# # return a list of plots to be displayed -# options: # options that can be passed as arguments to the function -# optname: # option name, the same as the argument that is passed to the rendering function -# type: # type of the option/widget, one of: text, numeric, select -# label: # label to be displayed in the editing widget -# default: # default value to be provided in the field; if provided, will overwrite function -# # argument defaults. if left empty, function defaults will be applied; if type is selected, -# # '.all' keyword can be applied to select all choices -# multiple: # applicable to 'select' type, whether to allow for multiple values to be selected -# choices: # applicable to 'select' type, choices to pick from the dropdown, either specified -# # outright or using a special keyword: - # - .colnames keyword will pull the choices from the data column names - # - .COLUMN_NAME keyword will pull choices from values of a specific column -# There are additional keywords to allow shaping the resulting interface: -# .group_label_N: # will create a label to help visually group related widgets; should be a character -# # string; N should be replaced with an integer to uniquely identify the keyword -# -# template: # You can also specify template definitions. This is a character string with id of another TLG definition. -# # All options will be copied over from template id. Any provided parameters will be a) overwritten if existing -# # in the template or b) added as new. +# Configuration file containing TLG definitions. +# To learn more, please check .github/contributing/adding-tlg.md g_pkconc_ind_lin: is_default: true type: Graph From c838ccb1589a8a9715372431344b7c94129d627f Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Tue, 17 Dec 2024 17:18:15 +0100 Subject: [PATCH 62/93] feat, wip: dynamic title and subtitle; fix: footnote working with plotly --- R/g_pkconc_ind.R | 89 ++++++++++++++++++++++++++++++++++++------------ 1 file changed, 68 insertions(+), 21 deletions(-) diff --git a/R/g_pkconc_ind.R b/R/g_pkconc_ind.R index 99fc2f7..9a97ee7 100644 --- a/R/g_pkconc_ind.R +++ b/R/g_pkconc_ind.R @@ -87,6 +87,8 @@ pkcg01 <- function( # " (", unique(adpc[[yvar_unit]]), ")")), xlab = paste0(xvar, " [", unique(adpc[[xvar_unit]]), "]"), ylab = paste0(yvar, " [", unique(adpc[[yvar_unit]]), "]"), + title = NULL, + subtitle = NULL, footnote = NULL, # Inputs to split-by/seggregate plots plotgroup_vars = c("ROUTE", "PCSPEC", "PARAM", "USUBJID"), @@ -103,20 +105,27 @@ pkcg01 <- function( ymax <- as.numeric(ymax) # Title for the plots based on display option - title <- paste0( - "Plot of PK Concentration-Time Profile ", - dplyr::case_when( - scale == "LIN" ~ "linear", - scale == "LOG" ~ "logarithmic", - TRUE ~ "linear and logarithmic" - ), - " scale" - ) + title <- { + if (is.null(title)) { + paste0( + "Plot of PK Concentration-Time Profile ", + dplyr::case_when( + scale == "LIN" ~ "linear", + scale == "LOG" ~ "logarithmic", + TRUE ~ "linear and logarithmic" + ), + " scale" + ) + } else { + title + } + } # Include in data figure details: title, subtitle, footnote/caption adpc <- add_figure_details( adpc = adpc, title = title, + subtitle = subtitle, collapse_subtitle = ", ", studyid = studyid, # Includes cohort in title trt_var = trt_var, # Includes treatment in subtitle @@ -218,15 +227,46 @@ pkcg01 <- function( # Create the list of plots for each unique group lapply(unique(adpc[["id_plot"]]), \(id_val) { plot_data <- adpc %>% dplyr::filter(id_plot == id_val) - plot %+% - labs( - title = unique(plot_data$title), - subtitle = unique(plot_data$subtitle), - caption = unique(plot_data$footnote), - ) %+% - plot_data %>% - ggplotly(tooltip = c("x", "y")) + #' TODO: find good magic numbers for title margin. + #' TODO: large margins make the plotting area smaller, adjust plot height + title <- paste0( + unique(plot_data$title), "
", + "", unique(plot_data$subtitle), "" + ) + title_margin <- (0.5 * length(unlist(strsplit(title, "\n|
")))) + + #' magic numbers for footnote position and margin, work in app up to 4 lines + footnote <- unique(plot_data$footnote) + footnote_y <- 0.175 + (0.1 * length(unlist(strsplit(footnote, "\n|
")))) + + plot %+% + plot_data %+% + theme( + # add margin to make space for subtitle and footnote # + plot.margin = margin( + title_margin, + 0, + footnote_y * 5, + 0, + "cm" + ) + ) %>% + ggplotly(tooltip = c("x", "y")) %>% + layout( + # title and subtitle # + title = list(text = title), + # footnote # + annotations = list( + x = 0, + y = -footnote_y, + text = footnote, + showarrow = FALSE, + yref = "paper", + xref = "paper", + align = "left" + ) + ) }) |> setNames(unique(adpc[["id_plot"]])) } @@ -251,6 +291,7 @@ pkcg01 <- function( add_figure_details <- function( adpc, title = "", # Specified by metadata + subtitle = "", collapse_subtitle = "\n", studyid = NULL, # Include or not in t trt_var, # Include or not in subtitle @@ -266,10 +307,16 @@ add_figure_details <- function( rowwise() %>% dplyr::mutate( title = if (is.null(studyid)) title else paste0(title, ", by Cohort: ", !!sym(studyid)), - subtitle = paste( - paste(c(plotgroup_names), ": ", c_across(all_of(plotgroup_vars)), sep = ""), - collapse = collapse_subtitle - ), + subtitle = { + if (is.null(subtitle)) { + paste( + paste(c(plotgroup_names), ": ", c_across(all_of(plotgroup_vars)), sep = ""), + collapse = collapse_subtitle + ) + } else { + subtitle + } + }, footnote = { footnote <- if (is.null(footnote)) "" else paste0(footnote, "\n") From de14e39e927a1d7196ec523e059644aa5680a633 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Tue, 17 Dec 2024 17:27:01 +0100 Subject: [PATCH 63/93] docs: roxygen update --- man/add_figure_details.Rd | 1 + man/pkcg01.Rd | 5 +++++ 2 files changed, 6 insertions(+) diff --git a/man/add_figure_details.Rd b/man/add_figure_details.Rd index fa7c397..68f7d49 100644 --- a/man/add_figure_details.Rd +++ b/man/add_figure_details.Rd @@ -7,6 +7,7 @@ add_figure_details( adpc, title = "", + subtitle = "", collapse_subtitle = "\\n", studyid = NULL, trt_var, diff --git a/man/pkcg01.Rd b/man/pkcg01.Rd index b05c603..836ea1b 100644 --- a/man/pkcg01.Rd +++ b/man/pkcg01.Rd @@ -20,6 +20,8 @@ pkcg01( ymax = NA, xlab = paste0(xvar, " [", unique(adpc[[xvar_unit]]), "]"), ylab = paste0(yvar, " [", unique(adpc[[yvar_unit]]), "]"), + title = NULL, + subtitle = NULL, footnote = NULL, plotgroup_vars = c("ROUTE", "PCSPEC", "PARAM", "USUBJID"), plotgroup_names = c("Route", "Specimen", "Analyte", "Subject ID"), @@ -77,4 +79,7 @@ This function generates a list of ggplots for PK concentration-time profiles. } \author{ Gerardo Rodriguez +TODO: find good magic numbers for title margin. +TODO: large margins make the plotting area smaller, adjust plot height +magic numbers for footnote position and margin, work in app up to 4 lines } From 0c8d87681a20bb342097a15529624d67f05535a5 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Wed, 18 Dec 2024 09:01:45 +0100 Subject: [PATCH 64/93] refactor: changed column name keyword denominator to $ --- .github/contributing/adding-tlg.md | 2 +- inst/shiny/modules/tlg_plot.R | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/contributing/adding-tlg.md b/.github/contributing/adding-tlg.md index 74807b5..2c5e174 100644 --- a/.github/contributing/adding-tlg.md +++ b/.github/contributing/adding-tlg.md @@ -51,7 +51,7 @@ id: multiple: # applicable to 'select' type, choices to pick from the dropdown, either specified outright or using a special keyword: # - '.colnames' keyword will pull the choices from the data column names - # - '.COLUMN_NAME' keyword will pull choices from values of a specific column + # - '$COLUMN_NAME' keyword will pull choices from values of a specific column choices: # will create a label to help visually group related widgets; should be a character string; N should be replaced with an integer to uniquely identify the keyword .group_label_N: diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R index 5e426b0..75a0aaf 100644 --- a/inst/shiny/modules/tlg_plot.R +++ b/inst/shiny/modules/tlg_plot.R @@ -166,8 +166,8 @@ create_edit_widget <- function(opt_def, opt_id, session = shiny::getDefaultReact choices <- { if (isTRUE(opt_def$choices == ".colnames")) { names(session$userData$data()) - } else if (length(opt_def$choices) == 1 && grepl("^\\.", opt_def$choices)) { - unique(session$userData$data()[, sub("^\\.", "", opt_def$choices)]) + } else if (length(opt_def$choices) == 1 && grepl("^\\$", opt_def$choices)) { + unique(session$userData$data()[, sub("^\\$", "", opt_def$choices)]) } else { opt_def$choices } From dc2da301fbb0e1c8c83ff2521b7090d9bf2d3cd4 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Wed, 18 Dec 2024 12:33:52 +0100 Subject: [PATCH 65/93] feat: function for parsing annotation text --- NAMESPACE | 3 +++ R/utils-tlg.R | 27 +++++++++++++++++++++++++++ man/parse_annotation.Rd | 33 +++++++++++++++++++++++++++++++++ tests/testthat/test-utils-tlg.R | 27 +++++++++++++++++++++++++++ 4 files changed, 90 insertions(+) create mode 100644 R/utils-tlg.R create mode 100644 man/parse_annotation.Rd create mode 100644 tests/testthat/test-utils-tlg.R diff --git a/NAMESPACE b/NAMESPACE index 64019ee..c451fbf 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -16,6 +16,7 @@ export(general_meanplot) export(geometric_mean) export(has_label) export(lambda_slope_plot) +export(parse_annotation) export(pkcg01) export(pptestcd_dict) export(reshape_pknca_results) @@ -71,6 +72,7 @@ importFrom(ggplot2,ggplot_build) importFrom(ggplot2,ggplot_gtable) importFrom(ggplot2,labs) importFrom(ggplot2,scale_x_continuous) +importFrom(glue,glue) importFrom(grid,convertUnit) importFrom(htmlwidgets,JS) importFrom(logger,log_debug) @@ -79,6 +81,7 @@ importFrom(logger,log_fatal) importFrom(logger,log_info) importFrom(logger,log_trace) importFrom(logger,log_warn) +importFrom(magrittr,`%>%`) importFrom(plotly,event_data) importFrom(plotly,plotlyOutput) importFrom(plotly,plotly_build) diff --git a/R/utils-tlg.R b/R/utils-tlg.R new file mode 100644 index 0000000..4780fc2 --- /dev/null +++ b/R/utils-tlg.R @@ -0,0 +1,27 @@ +#' Parses annotations in the context of data. Special characters and syntax are substituted by +#' actual data and/or substituted for format that is better parsed via rendering functions +#' (e.g. plotly). +#' +#' @details +#' * `\n` character is substituted for `
` tag in order to add new lines in redered image. +#' * `$COLNAME` is parsed to privde unique data value from the mentioned column. +#' * `!COLNAME` is parsed to provide `label` attribute for a given column name. +#' If any values are missing from the provided data, they are substituted for `ERR` string. +#' +#' @param data Data frame containing data to reference. Should include columns and labels referenced +#' in the text string. Referenced variables should be able to produce single unique +#' result. +#' @param text Character text to parse. +#' @returns Parsed annotation text. +#' +#' @importFrom magrittr `%>%` +#' @importFrom glue glue +#' +#' @export +parse_annotation <- function(data, text) { + text %>% + gsub("\n", "
", .) %>% + gsub("\\$(\\w+)", "{unique(data[['\\1']])}", .) %>% + gsub("!(\\w+)", "{attr(data[['\\1']], 'label')}", .) %>% + glue::glue(.na = "ERR", .null = "ERR") +} diff --git a/man/parse_annotation.Rd b/man/parse_annotation.Rd new file mode 100644 index 0000000..b87a3b6 --- /dev/null +++ b/man/parse_annotation.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils-tlg.R +\name{parse_annotation} +\alias{parse_annotation} +\title{Parses annotations in the context of data. Special characters and syntax are substituted by +actual data and/or substituted for format that is better parsed via rendering functions +(e.g. plotly).} +\usage{ +parse_annotation(data, text) +} +\arguments{ +\item{data}{Data frame containing data to reference. Should include columns and labels referenced +in the text string. Referenced variables should be able to produce single unique +result.} + +\item{text}{Character text to parse.} +} +\value{ +Parsed annotation text. +} +\description{ +Parses annotations in the context of data. Special characters and syntax are substituted by +actual data and/or substituted for format that is better parsed via rendering functions +(e.g. plotly). +} +\details{ +\itemize{ +\item \verb{\\n} character is substituted for \verb{
} tag in order to add new lines in redered image. +\item \verb{$COLNAME} is parsed to privde unique data value from the mentioned column. +\item \code{!COLNAME} is parsed to provide \code{label} attribute for a given column name. +If any values are missing from the provided data, they are substituted for \code{ERR} string. +} +} diff --git a/tests/testthat/test-utils-tlg.R b/tests/testthat/test-utils-tlg.R new file mode 100644 index 0000000..1834fe7 --- /dev/null +++ b/tests/testthat/test-utils-tlg.R @@ -0,0 +1,27 @@ +describe("parse_annotation", { + mock_data <- tibble( + GROUP = "XX01", + DOSE = "10", + DOSEU = "mg" + ) + attr(mock_data[["DOSE"]], "label") <- "Administered dose" + + it("parses title string correctly", { + expect_equal( + parse_annotation(mock_data, "Group $GROUP\n!DOSE: $DOSE [$DOSEU]"), + "Group XX01
Administered dose: 10 [mg]" + ) + }) + + it("substitutes missing variables with ERR", { + expect_equal( + parse_annotation(mock_data, "Column: $INVALID"), + "Column: ERR" + ) + + expect_equal( + parse_annotation(mock_data, "Label: !GROUP"), + "Label: ERR" + ) + }) +}) \ No newline at end of file From 8f351ea200e3975eb82c0387a5165bc0f069b170 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Wed, 18 Dec 2024 13:24:53 +0100 Subject: [PATCH 66/93] feat: implemented working dynamic titles and subtitles with column references --- R/g_pkconc_ind.R | 180 ++++++++++++-------------------------- inst/shiny/tlg.yaml | 7 +- man/add_figure_details.Rd | 51 ----------- man/pkcg01.Rd | 3 +- 4 files changed, 62 insertions(+), 179 deletions(-) delete mode 100644 man/add_figure_details.Rd diff --git a/R/g_pkconc_ind.R b/R/g_pkconc_ind.R index 9a97ee7..18b47fc 100644 --- a/R/g_pkconc_ind.R +++ b/R/g_pkconc_ind.R @@ -13,7 +13,7 @@ g_pkconc_ind_lin <- function(data, ...) { #' @returns ggplot2 object for pkcg01. #' @export g_pkconc_ind_log <- function(data, ...) { - pkcg01(adpc = data, scale = "LOG") + pkcg01(adpc = data, scale = "LOG", ...) } #' Generate PK Concentration-Time Profile Plots @@ -81,10 +81,6 @@ pkcg01 <- function( xmax = NA, ymin = NA, ymax = NA, - # xlab = substitute(paste0(attr(adpc[[xvar]], "label"), - # " (", unique(adpc[[xvar_unit]]), ")")), - # ylab = substitute(paste0(attr(adpc[[yvar]], "label"), - # " (", unique(adpc[[yvar_unit]]), ")")), xlab = paste0(xvar, " [", unique(adpc[[xvar_unit]]), "]"), ylab = paste0(yvar, " [", unique(adpc[[yvar_unit]]), "]"), title = NULL, @@ -104,38 +100,10 @@ pkcg01 <- function( ymin <- as.numeric(ymin) ymax <- as.numeric(ymax) - # Title for the plots based on display option - title <- { - if (is.null(title)) { - paste0( - "Plot of PK Concentration-Time Profile ", - dplyr::case_when( - scale == "LIN" ~ "linear", - scale == "LOG" ~ "logarithmic", - TRUE ~ "linear and logarithmic" - ), - " scale" - ) - } else { - title - } - } - - # Include in data figure details: title, subtitle, footnote/caption - adpc <- add_figure_details( - adpc = adpc, - title = title, - subtitle = subtitle, - collapse_subtitle = ", ", - studyid = studyid, # Includes cohort in title - trt_var = trt_var, # Includes treatment in subtitle - plotgroup_vars = plotgroup_vars, - plotgroup_names = plotgroup_names, - xvar_unit = xvar_unit, - xmin = as.numeric(xmin), - xmax = as.numeric(xmax), - footnote = footnote - ) + adpc <- adpc %>% + mutate(across(all_of(plotgroup_vars), as.character)) %>% + rowwise() %>% + dplyr::mutate(id_plot = interaction(!!!syms(plotgroup_vars))) # Construct the reference ggplot object plot_data <- adpc %>% filter(id_plot == id_plot[1]) @@ -144,9 +112,9 @@ pkcg01 <- function( df = plot_data, xvar = xvar, yvar = yvar, - xlab = xlab, - ylab = ylab, - id_var = "subtitle", + xlab = parse_annotation(plot_data, xlab), + ylab = parse_annotation(plot_data, ylab), + id_var = "USUBJID", add_baseline_hline = FALSE, yvar_baseline = yvar, plotting_choices = "separate_by_obs" @@ -228,17 +196,48 @@ pkcg01 <- function( lapply(unique(adpc[["id_plot"]]), \(id_val) { plot_data <- adpc %>% dplyr::filter(id_plot == id_val) - #' TODO: find good magic numbers for title margin. - #' TODO: large margins make the plotting area smaller, adjust plot height - title <- paste0( - unique(plot_data$title), "
", - "", unique(plot_data$subtitle), "" - ) - title_margin <- (0.5 * length(unlist(strsplit(title, "\n|
")))) + title <- { + if (is.null(title)) { + paste0( + "Plot of PK Concentration-Time Profile ", + dplyr::case_when( + scale == "LIN" ~ "linear", + scale == "LOG" ~ "logarithmic", + TRUE ~ "linear and logarithmic" + ), + " scale, by Cohort: ", unique(plot_data[[studyid]]) + ) + } else { + parse_annotation(plot_data, title) + } + } + + subtitle <- { + if (is.null(subtitle)) { + paste0( + "Treatment Group: ", unique(plot_data[[trt_var]]), " (N=", nrow(plot_data), ")
", + paste( + c(plotgroup_names), ": ", unique(plot_data[, plotgroup_vars]), + sep = "", collapse = ", " + ) + ) + } else { + parse_annotation(plot_data, subtitle) + } + } + + title_text <- paste0(title, "
", "", subtitle, "") + title_margin <- (0.5 * length(unlist(strsplit(title_text, "\n|
")))) #' magic numbers for footnote position and margin, work in app up to 4 lines - footnote <- unique(plot_data$footnote) - footnote_y <- 0.175 + (0.1 * length(unlist(strsplit(footnote, "\n|
")))) + footnote <- { + if (is.null(footnote)) { + "" + } else { + parse_annotation(plot_data, footnote) + } + } + footnote_y <- 0.1 + (0.05 * length(unlist(strsplit(footnote, "\n|
")))) plot %+% plot_data %+% @@ -252,10 +251,15 @@ pkcg01 <- function( "cm" ) ) %>% - ggplotly(tooltip = c("x", "y")) %>% + ggplotly( + tooltip = c("x", "y"), + dynamicTicks = TRUE, + #' NOTE: might require some fine tuning down the line, looks fine now + height = 500 + (footnote_y * 25) + title_margin * 50 + ) %>% layout( # title and subtitle # - title = list(text = title), + title = list(text = title_text), # footnote # annotations = list( x = 0, @@ -270,77 +274,3 @@ pkcg01 <- function( }) |> setNames(unique(adpc[["id_plot"]])) } - -#' Add Figure Details to Data Frame -#' -#' This function adds figure details; title, subtitle, and caption to the data. -#' -#' @param adpc A data frame containing the data. -#' @param plotgroup_vars A character vector of the grouping data variables. -#' @param plotgroup_names A character vector for the grouping variables names. -#' @param studyid A character string specifying the study ID variable. -#' @param xvar_unit A character string for the unit for the x-axis variable. -#' @param xmin A numeric value specifying the minimum x-axis limit. -#' @param xmax A numeric value specifying the maximum x-axis limit. -#' @param footnote A character string specifying plot's manual footnote. -#' @param trt_var A character string specifying the treatment variable. -#' @param title A character string specifying the title for the plot. -#' @returns A data frame with added figure details. -#' @importFrom dplyr mutate across rowwise ungroup group_by n -#' @author Gerardo Rodriguez -add_figure_details <- function( - adpc, - title = "", # Specified by metadata - subtitle = "", - collapse_subtitle = "\n", - studyid = NULL, # Include or not in t - trt_var, # Include or not in subtitle - plotgroup_vars, - plotgroup_names, - xvar_unit, - xmin = NA, - xmax = NA, - footnote = NULL -) { - adpc %>% - mutate(across(all_of(plotgroup_vars), as.character)) %>% - rowwise() %>% - dplyr::mutate( - title = if (is.null(studyid)) title else paste0(title, ", by Cohort: ", !!sym(studyid)), - subtitle = { - if (is.null(subtitle)) { - paste( - paste(c(plotgroup_names), ": ", c_across(all_of(plotgroup_vars)), sep = ""), - collapse = collapse_subtitle - ) - } else { - subtitle - } - }, - footnote = { - footnote <- if (is.null(footnote)) "" else paste0(footnote, "\n") - - if (!is.na(xmax)) { - footnote <- paste0( - footnote, - "Plot not showing observations beyond ", xmax, " ", !!sym(xvar_unit), ".\n" - ) - } - - if (!is.na(xmin)) { - footnote <- paste0( - footnote, "Plot not showing observations before ", xmin, " ", !!sym(xvar_unit), ".\n" - ) - } - - footnote - } - ) %>% - ungroup() %>% - dplyr::mutate(id_plot = interaction(!!!syms(plotgroup_vars))) %>% - dplyr::group_by(!!!syms(c(trt_var, plotgroup_vars))) %>% - dplyr::mutate( - subtitle = paste0("Treatment Group: ", !!sym(trt_var), " (N=", n(), ")\n", subtitle) - ) %>% - ungroup() -} diff --git a/inst/shiny/tlg.yaml b/inst/shiny/tlg.yaml index ccb5768..b9d290b 100644 --- a/inst/shiny/tlg.yaml +++ b/inst/shiny/tlg.yaml @@ -25,13 +25,18 @@ g_pkconc_ind_lin: - PCSPEC - PARAM - USUBJID - # TODO: splitting variable color_var: type: select label: "Color variable" choices: .colnames .group_label_2: "Labels" + title: + type: text + label: Title + subtitle: + type: text + label: Subtitle footnote: type: text label: Footnote diff --git a/man/add_figure_details.Rd b/man/add_figure_details.Rd deleted file mode 100644 index 68f7d49..0000000 --- a/man/add_figure_details.Rd +++ /dev/null @@ -1,51 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/g_pkconc_ind.R -\name{add_figure_details} -\alias{add_figure_details} -\title{Add Figure Details to Data Frame} -\usage{ -add_figure_details( - adpc, - title = "", - subtitle = "", - collapse_subtitle = "\\n", - studyid = NULL, - trt_var, - plotgroup_vars, - plotgroup_names, - xvar_unit, - xmin = NA, - xmax = NA, - footnote = NULL -) -} -\arguments{ -\item{adpc}{A data frame containing the data.} - -\item{title}{A character string specifying the title for the plot.} - -\item{studyid}{A character string specifying the study ID variable.} - -\item{trt_var}{A character string specifying the treatment variable.} - -\item{plotgroup_vars}{A character vector of the grouping data variables.} - -\item{plotgroup_names}{A character vector for the grouping variables names.} - -\item{xvar_unit}{A character string for the unit for the x-axis variable.} - -\item{xmin}{A numeric value specifying the minimum x-axis limit.} - -\item{xmax}{A numeric value specifying the maximum x-axis limit.} - -\item{footnote}{A character string specifying plot's manual footnote.} -} -\value{ -A data frame with added figure details. -} -\description{ -This function adds figure details; title, subtitle, and caption to the data. -} -\author{ -Gerardo Rodriguez -} diff --git a/man/pkcg01.Rd b/man/pkcg01.Rd index 836ea1b..9b1d26a 100644 --- a/man/pkcg01.Rd +++ b/man/pkcg01.Rd @@ -79,7 +79,6 @@ This function generates a list of ggplots for PK concentration-time profiles. } \author{ Gerardo Rodriguez -TODO: find good magic numbers for title margin. -TODO: large margins make the plotting area smaller, adjust plot height magic numbers for footnote position and margin, work in app up to 4 lines +NOTE: might require some fine tuning down the line, looks fine now } From c2858ca00600ace4cf3fe4a8f1d09f82cc2a41d5 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Wed, 18 Dec 2024 15:02:31 +0100 Subject: [PATCH 67/93] feat: Help widget --- inst/shiny/modules/tlg_plot.R | 40 ++++++++++++++++++++++++++++------- inst/shiny/www/style.css | 18 +++++++++++++++- 2 files changed, 49 insertions(+), 9 deletions(-) diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R index 75a0aaf..c873882 100644 --- a/inst/shiny/modules/tlg_plot.R +++ b/inst/shiny/modules/tlg_plot.R @@ -4,7 +4,37 @@ tlg_plot_ui <- function(id) { layout_sidebar( sidebar = sidebar( position = "right", - uiOutput(ns("options"), class = "plot-options-container") + div( + class = "plot-options-container", + dropdown( + div( + tags$h2("Plot options"), + tags$p(" + You can specify any plot customization options that are supported by the specific + plot module. + "), + tags$p("Leaving a widget empty will allow default behaviour of the plotting function."), + tags$p( + "In text fields, you can reference values / columns in the dataset by using + the dollar sign (", tags$b("$"), ") and providing column name, e.g. ", + tags$b("$DOSEU"), "." + ), + tags$p(" + You can also reference ", tags$i("label"), " attribute of any column by prefacing the + column name by exclamation mark (", tags$b("!"), "), e.g. ", tags$b("!DOSEU"), ". + ") + ), + style = "unite", + right = TRUE, + icon = icon("question"), + status = "primary" + ), + actionButton( + inputId = ns("reset_widgets"), + label = "Reset to defaults" + ), + uiOutput(ns("options"), class = "plot-options-container") + ) ), div( class = "plot-widgets-container", @@ -123,13 +153,7 @@ tlg_plot_server <- function(id, render_plot, options = NULL) { #' creates widgets responsible for custimizing the plots output$options <- renderUI({ - tagList( - actionButton( - inputId = session$ns("reset_widgets"), - label = "Reset to defaults" - ), - purrr::imap(options, create_edit_widget) - ) + purrr::imap(options, create_edit_widget) }) }) } diff --git a/inst/shiny/www/style.css b/inst/shiny/www/style.css index e3ca096..02e9ba1 100644 --- a/inst/shiny/www/style.css +++ b/inst/shiny/www/style.css @@ -154,6 +154,22 @@ height: min-content; } + .sw-dropdown { + font-size: 1em; + display: block; + position: relative; + top: -2.5em; + right: -0.5em; + margin-bottom: -1.25em; + height: 2em; + width: 2em; + float: right; + } + + .sw-dropdown-in { + width: 200px; + } + .plot-widgets-container { display: flex; justify-content: space-around; @@ -171,7 +187,7 @@ } .plot-options-container { - button { + & > button { width: 75%; margin-left: 15%; margin-top: 1em; From b9c7d020ee3442fd9f4e23536358f171a4675c46 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 19 Dec 2024 08:01:16 +0100 Subject: [PATCH 68/93] refactor: nicer button styling --- inst/shiny/modules/tab_tlg.R | 21 ++++++++++++++++----- 1 file changed, 16 insertions(+), 5 deletions(-) diff --git a/inst/shiny/modules/tab_tlg.R b/inst/shiny/modules/tab_tlg.R index 7c7bee3..9fefb3e 100644 --- a/inst/shiny/modules/tab_tlg.R +++ b/inst/shiny/modules/tab_tlg.R @@ -32,11 +32,22 @@ tab_tlg_ui <- function(id) { id = ns("tlg_tabs"), nav_panel( "Order details", - actionButton(ns("add_tlg"), "Add TLG"), - actionButton(ns("remove_tlg"), "Remove TLG"), - actionButton(ns("submit_tlg_order"), "Submit Order Details"), - DTOutput(ns("selected_tlg_table")), - actionButton(ns("submit_tlg_order_alt"), "Submit Order Details") + card( + style = "margin-top: 1em;", + div( + actionButton(ns("add_tlg"), "Add TLG"), + actionButton(ns("remove_tlg"), "Remove TLG"), + actionButton(ns("submit_tlg_order"), "Submit Order Details", class = "btn-primary") + ) + ), + card( + DTOutput(ns("selected_tlg_table")) + ), + card( + div( + actionButton(ns("submit_tlg_order_alt"), "Submit Order Details", class = "btn-primary") + ) + ) ), nav_panel("Tables", "To be added"), nav_panel("Listings", "To be added"), From 2a7cf6576963b5a6dc0ba06edd326b8c40fe24bb Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 19 Dec 2024 08:01:38 +0100 Subject: [PATCH 69/93] fix: explicit widget id warning --- inst/shiny/modules/tab_tlg.R | 1 - 1 file changed, 1 deletion(-) diff --git a/inst/shiny/modules/tab_tlg.R b/inst/shiny/modules/tab_tlg.R index 9fefb3e..b13edcc 100644 --- a/inst/shiny/modules/tab_tlg.R +++ b/inst/shiny/modules/tab_tlg.R @@ -99,7 +99,6 @@ tab_tlg_server <- function(id) { output$selected_tlg_table <- DT::renderDT({ log_trace("Rendering TLG table.") datatable( - elementId = "selected_tlg_datatable", class = "table table-striped table-bordered", data = dplyr::filter(tlg_order(), Selection), editable = list( From 554373abef13faaf52c53b1d82d07a48edd2f9b3 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 19 Dec 2024 08:07:32 +0100 Subject: [PATCH 70/93] fix: app crashing when no data is available --- inst/shiny/modules/tab_tlg.R | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/inst/shiny/modules/tab_tlg.R b/inst/shiny/modules/tab_tlg.R index b13edcc..ba98a68 100644 --- a/inst/shiny/modules/tab_tlg.R +++ b/inst/shiny/modules/tab_tlg.R @@ -224,8 +224,15 @@ tab_tlg_server <- function(id) { } }) + # Toggle submit button depending on whether the data is available # + observeEvent(session$userData$data(), ignoreInit = FALSE, ignoreNULL = FALSE, { + shinyjs::toggleState("submit_tlg_order", !is.null(session$userData$data())) + shinyjs::toggleState("submit_tlg_order_alt", !is.null(session$userData$data())) + }) + # When the user submits the TLG order... observeEvent(list(input$submit_tlg_order, input$submit_tlg_order_alt), ignoreInit = TRUE, { + req(session$userData$data()) log_trace("Submitting TLG order...") tlg_order_filt <- tlg_order()[tlg_order()$Selection, ] From 7e16c7aa1892f9e38461a86ccc7497f9a7dcbcf3 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 19 Dec 2024 08:11:29 +0100 Subject: [PATCH 71/93] fix: geom_logicts warning --- R/g_pkconc_ind.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/g_pkconc_ind.R b/R/g_pkconc_ind.R index 18b47fc..88fa368 100644 --- a/R/g_pkconc_ind.R +++ b/R/g_pkconc_ind.R @@ -167,7 +167,6 @@ pkcg01 <- function( breaks = scales::trans_breaks("log10", \(x) 10^x), labels = scales::trans_format("log10", scales::math_format(10^.x)) ) + - annotation_logticks(sides = "l") + labs(y = paste0("Log 10 - ", plot$labels$y)) } @@ -183,7 +182,6 @@ pkcg01 <- function( plot <- plot %+% dplyr::filter(adpc, id_plot == unique(id_plot)[1]) + facet_wrap(~ view, scales = "free_y") + - annotation_logticks(sides = "l", linewidth = 0.1, alpha = c(0, 1)) + ggh4x::scale_y_facet( view == "Semilogarithmic view (Log10)", trans = "log10", @@ -239,6 +237,8 @@ pkcg01 <- function( } footnote_y <- 0.1 + (0.05 * length(unlist(strsplit(footnote, "\n|
")))) + # TODO: implement logtics in plotly + plot %+% plot_data %+% theme( From 12a5dc611efee1454d0f3d4944a5945f165486f4 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 19 Dec 2024 11:16:12 +0100 Subject: [PATCH 72/93] fix: labels being an expression instead of a character vector --- R/g_pkconc_ind.R | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/R/g_pkconc_ind.R b/R/g_pkconc_ind.R index 88fa368..58e55ae 100644 --- a/R/g_pkconc_ind.R +++ b/R/g_pkconc_ind.R @@ -162,11 +162,7 @@ pkcg01 <- function( dplyr::mutate(across(all_of(yvar), ~ ifelse(. < 1e-3, 1e-3, .))) plot <- plot %+% dplyr::filter(adpc, id_plot == id_plot[1]) + - scale_y_continuous( - trans = scales::log10_trans(), - breaks = scales::trans_breaks("log10", \(x) 10^x), - labels = scales::trans_format("log10", scales::math_format(10^.x)) - ) + + scale_y_continuous(trans = scales::log10_trans()) + labs(y = paste0("Log 10 - ", plot$labels$y)) } @@ -268,7 +264,8 @@ pkcg01 <- function( showarrow = FALSE, yref = "paper", xref = "paper", - align = "left" + align = "left", + parse = TRUE ) ) }) |> From eab678196aed7b07621b8236175773e8a7c5f361 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 19 Dec 2024 11:24:19 +0100 Subject: [PATCH 73/93] fix: log scale in plotly --- R/g_pkconc_ind.R | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/R/g_pkconc_ind.R b/R/g_pkconc_ind.R index 58e55ae..8ffcaed 100644 --- a/R/g_pkconc_ind.R +++ b/R/g_pkconc_ind.R @@ -157,12 +157,7 @@ pkcg01 <- function( if (scale == "LOG") { - # Create LOG version of data and plot - adpc <- adpc %>% - dplyr::mutate(across(all_of(yvar), ~ ifelse(. < 1e-3, 1e-3, .))) - - plot <- plot %+% dplyr::filter(adpc, id_plot == id_plot[1]) + - scale_y_continuous(trans = scales::log10_trans()) + + plot <- plot + labs(y = paste0("Log 10 - ", plot$labels$y)) } @@ -233,9 +228,7 @@ pkcg01 <- function( } footnote_y <- 0.1 + (0.05 * length(unlist(strsplit(footnote, "\n|
")))) - # TODO: implement logtics in plotly - - plot %+% + plotly_plot <- plot %+% plot_data %+% theme( # add margin to make space for subtitle and footnote # @@ -268,6 +261,13 @@ pkcg01 <- function( parse = TRUE ) ) + + if (scale == "LOG") { + plotly_plot <- plotly_plot %>% + layout(yaxis = list(type = "log")) + } + + plotly_plot }) |> setNames(unique(adpc[["id_plot"]])) } From 774c36d53a9911674ba49b4f4fa11ea4e5b573e5 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 19 Dec 2024 11:48:01 +0100 Subject: [PATCH 74/93] fix: spellcheck --- R/utils-tlg.R | 4 ++-- man/parse_annotation.Rd | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/utils-tlg.R b/R/utils-tlg.R index 4780fc2..314870e 100644 --- a/R/utils-tlg.R +++ b/R/utils-tlg.R @@ -3,8 +3,8 @@ #' (e.g. plotly). #' #' @details -#' * `\n` character is substituted for `
` tag in order to add new lines in redered image. -#' * `$COLNAME` is parsed to privde unique data value from the mentioned column. +#' * `\n` character is substituted for `
` tag in order to add new lines in rendered image. +#' * `$COLNAME` is parsed to provide unique data value from the mentioned column. #' * `!COLNAME` is parsed to provide `label` attribute for a given column name. #' If any values are missing from the provided data, they are substituted for `ERR` string. #' diff --git a/man/parse_annotation.Rd b/man/parse_annotation.Rd index b87a3b6..7e449e3 100644 --- a/man/parse_annotation.Rd +++ b/man/parse_annotation.Rd @@ -25,8 +25,8 @@ actual data and/or substituted for format that is better parsed via rendering fu } \details{ \itemize{ -\item \verb{\\n} character is substituted for \verb{
} tag in order to add new lines in redered image. -\item \verb{$COLNAME} is parsed to privde unique data value from the mentioned column. +\item \verb{\\n} character is substituted for \verb{
} tag in order to add new lines in rendered image. +\item \verb{$COLNAME} is parsed to provide unique data value from the mentioned column. \item \code{!COLNAME} is parsed to provide \code{label} attribute for a given column name. If any values are missing from the provided data, they are substituted for \code{ERR} string. } From 75dcc761cc3e31c880f522f9b63b9ba0485eb52a Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 19 Dec 2024 11:55:41 +0100 Subject: [PATCH 75/93] fix: automatic subtitle overflowing with group variables --- R/g_pkconc_ind.R | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/R/g_pkconc_ind.R b/R/g_pkconc_ind.R index 8ffcaed..85f8056 100644 --- a/R/g_pkconc_ind.R +++ b/R/g_pkconc_ind.R @@ -88,7 +88,13 @@ pkcg01 <- function( footnote = NULL, # Inputs to split-by/seggregate plots plotgroup_vars = c("ROUTE", "PCSPEC", "PARAM", "USUBJID"), - plotgroup_names = c("Route", "Specimen", "Analyte", "Subject ID"), + # TODO(mateusz): Refactor when label attributes are implemented. + plotgroup_names = list( + "ROUTE" = "Route", + "PCSPEC" = "Specimen", + "PARAM" = "Analyte", + "USUBJID" = "Subject ID" + ), # Specific inputs (needs metadata specification), scale = c("LIN", "LOG", "SBS")[1], @@ -205,8 +211,10 @@ pkcg01 <- function( if (is.null(subtitle)) { paste0( "Treatment Group: ", unique(plot_data[[trt_var]]), " (N=", nrow(plot_data), ")
", + # TODO(mateusz): Refactor when label attributes are implemented. paste( - c(plotgroup_names), ": ", unique(plot_data[, plotgroup_vars]), + unlist(unname(plotgroup_names[plotgroup_vars])), ": ", + unique(plot_data[, plotgroup_vars]), sep = "", collapse = ", " ) ) From 68e5accb25e784b8d1b0012de90ed61774a231ca Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 19 Dec 2024 12:38:58 +0100 Subject: [PATCH 76/93] docs: roxygen update --- man/pkcg01.Rd | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/man/pkcg01.Rd b/man/pkcg01.Rd index 9b1d26a..a09799d 100644 --- a/man/pkcg01.Rd +++ b/man/pkcg01.Rd @@ -24,7 +24,8 @@ pkcg01( subtitle = NULL, footnote = NULL, plotgroup_vars = c("ROUTE", "PCSPEC", "PARAM", "USUBJID"), - plotgroup_names = c("Route", "Specimen", "Analyte", "Subject ID"), + plotgroup_names = list(ROUTE = "Route", PCSPEC = "Specimen", PARAM = "Analyte", USUBJID + = "Subject ID"), scale = c("LIN", "LOG", "SBS")[1], studyid = "STUDYID", trt_var = "TRT01A" From 4f025fbdbc35058459a75f9447f4124c895bc6de Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 19 Dec 2024 13:05:07 +0100 Subject: [PATCH 77/93] fix: R CMD check, roxygen docs --- DESCRIPTION | 2 ++ NAMESPACE | 1 - R/g_pkconc_ind.R | 15 ++++++++------- man/pkcg01.Rd | 19 +++++++++++++++++++ 4 files changed, 29 insertions(+), 8 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 9e553f1..03c2cf2 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -34,9 +34,11 @@ Imports: forcats, ggh4x, ggplot2, + glue, haven, htmlwidgets, logger, + magrittr, nestcolor, PKNCA, plotly, diff --git a/NAMESPACE b/NAMESPACE index c451fbf..2fc6d3a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -98,7 +98,6 @@ importFrom(rio,export_list) importFrom(rmarkdown,render) importFrom(scales,breaks_log) importFrom(scales,label_log) -importFrom(scales,trans_breaks) importFrom(shinyBS,bsModal) importFrom(shinyFiles,shinyDirChoose) importFrom(shinyWidgets,dropdown) diff --git a/R/g_pkconc_ind.R b/R/g_pkconc_ind.R index 85f8056..3dbb921 100644 --- a/R/g_pkconc_ind.R +++ b/R/g_pkconc_ind.R @@ -43,24 +43,25 @@ g_pkconc_ind_log <- function(data, ...) { #' @returns A list of ggplot objects for each unique group. #' @importFrom dplyr mutate across rowwise ungroup group_by n #' @importFrom ggplot2 aes scale_x_continuous labs -#' @importFrom tern g_ipp # Can be substituted by regular ggplot easily!! +#' @importFrom tern g_ipp #' @importFrom checkmate assert_numeric -#' @importFrom scales breaks_log label_log trans_breaks trans_formats +#' @importFrom scales breaks_log label_log #' @importFrom ggh4x scale_y_facet #' #' @examples -#' \dontrun { +#' \dontrun{ #' adpc <- read.csv("inst/shiny/data/DummyRO_ADNCA.csv") #' attr(adpc[["AFRLT"]], "label") <- "Actual time from first dose" #' attr(adpc[["AVAL"]], "label") <- "Analysis val" #' -#' plots_lin <- pkcg01(adpc = adpc, xmax = 1) -#' plots_log <- pkcg01(adpc = adpc, color_var = "USUBJID", scale = "LOG) -#' plots_sbs <- pkcg01( +#' plots_lin <- pckg01(adpc = adpc, xmax = 1) +#' plots_log <- pckg01(adpc = adpc, color_var = "USUBJID", scale = "LOG") +#' plots_sbs <- pckg01( #' adpc = adpc, #' color_var = "USUBJID", #' xbreaks_var = "NFRLT", -#' xmin = 100, xmax = 1000, +#' xmin = 100, +#' xmax = 1000, #' scale = "SBS" #' ) #' } diff --git a/man/pkcg01.Rd b/man/pkcg01.Rd index a09799d..ecd0492 100644 --- a/man/pkcg01.Rd +++ b/man/pkcg01.Rd @@ -77,6 +77,25 @@ A list of ggplot objects for each unique group. } \description{ This function generates a list of ggplots for PK concentration-time profiles. +} +\examples{ +\dontrun{ + adpc <- read.csv("inst/shiny/data/DummyRO_ADNCA.csv") + attr(adpc[["AFRLT"]], "label") <- "Actual time from first dose" + attr(adpc[["AVAL"]], "label") <- "Analysis val" + + plots_lin <- pckg01(adpc = adpc, xmax = 1) + plots_log <- pckg01(adpc = adpc, color_var = "USUBJID", scale = "LOG") + plots_sbs <- pckg01( + adpc = adpc, + color_var = "USUBJID", + xbreaks_var = "NFRLT", + xmin = 100, + xmax = 1000, + scale = "SBS" + ) +} + } \author{ Gerardo Rodriguez From 8ae958146719ddc5e779769981fdda8ae2b5089e Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Fri, 20 Dec 2024 09:13:29 +0100 Subject: [PATCH 78/93] fix: labels getting lost on table mutations --- R/g_pkconc_ind.R | 26 +++++++++++++++++++------- 1 file changed, 19 insertions(+), 7 deletions(-) diff --git a/R/g_pkconc_ind.R b/R/g_pkconc_ind.R index 3dbb921..5612ccb 100644 --- a/R/g_pkconc_ind.R +++ b/R/g_pkconc_ind.R @@ -107,13 +107,22 @@ pkcg01 <- function( ymin <- as.numeric(ymin) ymax <- as.numeric(ymax) - adpc <- adpc %>% + # save col labels, as further adpc tranformations cause them to be lost # + col_labels <- purrr::map(adpc, ~ attr(.x, "label")) + + adpc_grouped <- adpc %>% mutate(across(all_of(plotgroup_vars), as.character)) %>% rowwise() %>% dplyr::mutate(id_plot = interaction(!!!syms(plotgroup_vars))) + # reapply col labels to grouped data # + adpc_grouped <- purrr::map2_dfc(adpc_grouped, names(adpc_grouped), ~ { + attr(.x, "label") <- col_labels[[.y]] + .x + }) + # Construct the reference ggplot object - plot_data <- adpc %>% filter(id_plot == id_plot[1]) + plot_data <- adpc_grouped %>% filter(id_plot == id_plot[1]) plot <- tern::g_ipp( df = plot_data, @@ -170,15 +179,18 @@ pkcg01 <- function( if (scale == "SBS") { # Create SBS version of data and plot - adpc <- rbind(adpc, adpc) %>% + adpc_grouped <- rbind(adpc_grouped, adpc_grouped) %>% dplyr::mutate( - view = c(rep("Linear view", nrow(adpc)), rep("Semilogarithmic view (Log10)", nrow(adpc))), + view = c( + rep("Linear view", nrow(adpc_grouped)), + rep("Semilogarithmic view (Log10)", nrow(adpc_grouped)) + ), !!sym(yvar) := ifelse( !!sym(yvar) < 1e-3 & view == "Semilogarithmic view (Log10)", yes = 1e-3, no = !!sym(yvar) ) ) - plot <- plot %+% dplyr::filter(adpc, id_plot == unique(id_plot)[1]) + + plot <- plot %+% dplyr::filter(adpc_grouped, id_plot == unique(id_plot)[1]) + facet_wrap(~ view, scales = "free_y") + ggh4x::scale_y_facet( view == "Semilogarithmic view (Log10)", @@ -189,8 +201,8 @@ pkcg01 <- function( } # Create the list of plots for each unique group - lapply(unique(adpc[["id_plot"]]), \(id_val) { - plot_data <- adpc %>% dplyr::filter(id_plot == id_val) + lapply(unique(adpc_grouped[["id_plot"]]), \(id_val) { + plot_data <- adpc_grouped %>% dplyr::filter(id_plot == id_val) title <- { if (is.null(title)) { From 4c4d7f3f17e000633677a5061d5ff190e580c195 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Fri, 20 Dec 2024 11:24:19 +0100 Subject: [PATCH 79/93] tests: added unit tests for pkcg01 --- tests/testthat/test-g_pkconc_ind.R | 110 +++++++++++++++++++++++++++++ 1 file changed, 110 insertions(+) create mode 100644 tests/testthat/test-g_pkconc_ind.R diff --git a/tests/testthat/test-g_pkconc_ind.R b/tests/testthat/test-g_pkconc_ind.R new file mode 100644 index 0000000..3185e91 --- /dev/null +++ b/tests/testthat/test-g_pkconc_ind.R @@ -0,0 +1,110 @@ +root <- rprojroot::find_root(rprojroot::is_r_package) +adpc <- read.csv(file.path(root, "inst/shiny/data/DummyRO_ADNCA.csv")) +attr(adpc$USUBJID, "label") <- "Subject ID" +attr(adpc$DOSEU, "label") <- "Dose unit" +adpc_single <- dplyr::filter(adpc, USUBJID == "11101") + +#' Converts plotly object to JSON +#' @param p plotly object +#' @returns a list with plotly object data +.get_plotly_json <- function(p) { + jsonlite::fromJSON(plotly::plotly_json(p, FALSE)) +} + +#' Checks basic expectations for plot list: +#' - is a list +#' - length is as expected +#' - each element is a plotly object +#' @param p_list plot list +#' @param list_length expected length of the list +.expect_plotlist <- function(p_list, list_length) { + expect_type(p_list, "list") + expect_equal(length(p_list), list_length) + purrr::walk(p_list, \(plot) expect_identical(class(plot), c("plotly", "htmlwidget"))) +} + +describe("pkcg01", { + it("generates valid plot list with default settings", { + p_list <- pkcg01(adpc) + .expect_plotlist(p_list, 23) + }) + + it("generates plot with custom labels", { + p_list <- pkcg01( + adpc_single, + "xlab" = "Test custom xlab", + "ylab" = "Test custom ylab", + "title" = "Test custom title", + "subtitle" = "Test custom subtitle", + "footnote" = "Test custom footnote" + ) + + .expect_plotlist(p_list, 1) + + p_json <- .get_plotly_json(p_list[[1]]) + expect_equal(p_json$layout$xaxis$title$text, "Test custom xlab") + expect_equal(p_json$layout$yaxis$title$text, "Test custom ylab") + expect_equal(p_json$layout$title$text, "Test custom title
Test custom subtitle") + expect_equal(p_json$layout$annotations[1, ]$text, "Test custom footnote") + }) + + it("generates plot with custom labels that include special syntax", { + p_list <- pkcg01( + adpc_single, + "xlab" = "Test $USUBJID", + "ylab" = "Test !USUBJID: $USUBJID", + "title" = "Test !DOSEU: $DOSEU", + "subtitle" = "Test $DOSEU\n$DOSEU", + "footnote" = "Test !USUBJID" + ) + + .expect_plotlist(p_list, 1) + + p_json <- .get_plotly_json(p_list[[1]]) + expect_equal(p_json$layout$xaxis$title$text, "Test 11101") + expect_equal(p_json$layout$yaxis$title$text, "Test Subject ID: 11101") + expect_equal(p_json$layout$title$text, "Test Dose unit: mg
Test mg
mg") + expect_equal(p_json$layout$annotations[1, ]$text, "Test Subject ID") + }) + + it("generates plot list in respect to grouping variables", { + p_list <- pkcg01(adpc, plotgroup_vars = c("ROUTE", "PCSPEC", "PARAM")) + .expect_plotlist(p_list, 1) + }) + + it("generates plots in respect to provided limits", { + p_list <- pkcg01( + adpc_single, + xmin = 10, + xmax = 150, + ymin = 1, + ymax = 3 + ) + + .expect_plotlist(p_list, 1) + + p_json <- .get_plotly_json(p_list[[1]]) + + #' NOTE: + #' Actual range expectations differ from values provided in function call since plotly + #' adds some margin. + expect_equal(p_json$layout$xaxis$range, c(3, 157)) + expect_equal(p_json$layout$yaxis$range, c(0.9, 3.1)) + }) +}) + +describe("g_pkconc_ind_lin", { + it("generates plot with linear scale", { + p_list <- g_pkconc_ind_lin(adpc_single) + p_json <- .get_plotly_json(p_list[[1]]) + expect_equal(p_json$layout$yaxis$type, "linear") + }) +}) + +describe("g_pkconc_ind_log", { + it("generates plot with log scale", { + p_list <- g_pkconc_ind_log(adpc_single) + p_json <- .get_plotly_json(p_list[[1]]) + expect_equal(p_json$layout$yaxis$type, "log") + }) +}) \ No newline at end of file From 005feb3360cca2b5715e3cd7ae25a5444ccbbd54 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Fri, 20 Dec 2024 11:44:49 +0100 Subject: [PATCH 80/93] fix: automatic tab switching --- inst/shiny/modules/tab_tlg.R | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/inst/shiny/modules/tab_tlg.R b/inst/shiny/modules/tab_tlg.R index ba98a68..2637d90 100644 --- a/inst/shiny/modules/tab_tlg.R +++ b/inst/shiny/modules/tab_tlg.R @@ -51,7 +51,7 @@ tab_tlg_ui <- function(id) { ), nav_panel("Tables", "To be added"), nav_panel("Listings", "To be added"), - nav_panel("Graphs", uiOutput(ns("graphs"), class = "tlg-plot-module")) + nav_panel("Graphs", uiOutput(ns("graphs"), class = "tlg-plot-module"), value = "Graphs") ) } @@ -288,11 +288,9 @@ tab_tlg_server <- function(id) { }) #' change tab to first populated tab - #' NOTE: currently only plots implemented, will change to Graphs tab - #' TODO: when Tables and/or Listings are implemented, detect which tab is populated and adjust - #' FIXME: for some reason this does not work with bslib - nav_select(id = "tlg_tabs", selected = "Graphs") - updateTabsetPanel(session, "tlg_tabs", selected = "Graphs") + #' for mysterious reasons nav_select() and updateTabsetPanel() were not working, + #' so solved this using JavaScript + shinyjs::runjs(paste0("$(`#", session$ns("tlg_tabs"), " a[data-value='Graphs']`)[0].click()")) }) }) } From c2f021262357225a76847b7ca157989fd28bde82 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Thu, 2 Jan 2025 16:59:00 +0100 Subject: [PATCH 81/93] fix: auto changing tabs --- inst/shiny/modules/tab_tlg.R | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/inst/shiny/modules/tab_tlg.R b/inst/shiny/modules/tab_tlg.R index 2637d90..c847110 100644 --- a/inst/shiny/modules/tab_tlg.R +++ b/inst/shiny/modules/tab_tlg.R @@ -290,7 +290,13 @@ tab_tlg_server <- function(id) { #' change tab to first populated tab #' for mysterious reasons nav_select() and updateTabsetPanel() were not working, #' so solved this using JavaScript - shinyjs::runjs(paste0("$(`#", session$ns("tlg_tabs"), " a[data-value='Graphs']`)[0].click()")) + #' TODO: Somehow detect when UI for plots is ready, only then change the tab + shinyjs::runjs( + paste0(" + setTimeout(() => { + $(`#", session$ns("tlg_tabs"), " a[data-value='Graphs']`)[0].click() + }, 3000);") + ) }) }) } From 84ffcca01f354b8cf24cf2f7f1de1224ff3e78b7 Mon Sep 17 00:00:00 2001 From: Pavel Demin Date: Wed, 8 Jan 2025 12:45:12 +0000 Subject: [PATCH 82/93] chore: add loading spinner to the tlg plot output --- DESCRIPTION | 1 + NAMESPACE | 1 + R/run_app.R | 1 + inst/shiny/modules/tlg_plot.R | 4 +++- 4 files changed, 6 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 03c2cf2..1727548 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -49,6 +49,7 @@ Imports: scales, shiny, shinyBS, + shinycssloaders, shinyFiles, shinyjqui, shinyjs, diff --git a/NAMESPACE b/NAMESPACE index 2fc6d3a..4f29f40 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -104,6 +104,7 @@ importFrom(shinyWidgets,dropdown) importFrom(shinyWidgets,pickerInput) importFrom(shinyWidgets,switchInput) importFrom(shinyWidgets,updatePickerInput) +importFrom(shinycssloaders,withSpinner) importFrom(shinyjqui,orderInput) importFrom(shinyjqui,updateOrderInput) importFrom(stats,sd) diff --git a/R/run_app.R b/R/run_app.R index 864c74d..588fb88 100644 --- a/R/run_app.R +++ b/R/run_app.R @@ -18,6 +18,7 @@ #' @importFrom rio export_list #' @importFrom rmarkdown render #' @importFrom shinyBS bsModal +#' @importFrom shinycssloaders withSpinner #' @importFrom shinyFiles shinyDirChoose #' @importFrom shinyjqui orderInput updateOrderInput #' @importFrom shinyWidgets dropdown pickerInput switchInput updatePickerInput diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R index c873882..9ce0403 100644 --- a/inst/shiny/modules/tlg_plot.R +++ b/inst/shiny/modules/tlg_plot.R @@ -68,7 +68,9 @@ tlg_plot_ui <- function(id) { ), div(align = "right", actionButton(ns("next_page"), "Next Page")) ), - uiOutput(ns("plots")) + shinycssloaders::withSpinner( + uiOutput(ns("plots")) + ) ) } From ab8e22763aa0e2485f5289d4775e0b2afa4e2d78 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Wed, 8 Jan 2025 15:24:42 +0100 Subject: [PATCH 83/93] refactor: removed fake wait before switching tabs --- inst/shiny/modules/tab_tlg.R | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/inst/shiny/modules/tab_tlg.R b/inst/shiny/modules/tab_tlg.R index c847110..a8c122b 100644 --- a/inst/shiny/modules/tab_tlg.R +++ b/inst/shiny/modules/tab_tlg.R @@ -287,15 +287,11 @@ tab_tlg_server <- function(id) { do.call(navset_pill_list, panels) }) - #' change tab to first populated tab + #' change tab to first populated tab (currently only Graphs) #' for mysterious reasons nav_select() and updateTabsetPanel() were not working, #' so solved this using JavaScript - #' TODO: Somehow detect when UI for plots is ready, only then change the tab shinyjs::runjs( - paste0(" - setTimeout(() => { - $(`#", session$ns("tlg_tabs"), " a[data-value='Graphs']`)[0].click() - }, 3000);") + paste0("$(`#", session$ns("tlg_tabs"), " a[data-value='Graphs']`)[0].click();") ) }) }) From 290956fb6fad70b7303728aa670fea91e2b5497d Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Wed, 8 Jan 2025 16:04:14 +0100 Subject: [PATCH 84/93] fix: prevent plots from initially loading twice --- inst/shiny/modules/tab_tlg.R | 14 ++++++++++++-- inst/shiny/modules/tlg_plot.R | 8 +++++++- 2 files changed, 19 insertions(+), 3 deletions(-) diff --git a/inst/shiny/modules/tab_tlg.R b/inst/shiny/modules/tab_tlg.R index a8c122b..f11ccf9 100644 --- a/inst/shiny/modules/tab_tlg.R +++ b/inst/shiny/modules/tab_tlg.R @@ -51,7 +51,9 @@ tab_tlg_ui <- function(id) { ), nav_panel("Tables", "To be added"), nav_panel("Listings", "To be added"), - nav_panel("Graphs", uiOutput(ns("graphs"), class = "tlg-plot-module"), value = "Graphs") + nav_panel("Graphs", uiOutput(ns("graphs"), class = "tlg-plot-module"), value = "Graphs"), + # disable loader for initial empty UI render # + tags$style(HTML(paste0(".tlg-plot-module .load-container {opacity: 0;}"))) ) } @@ -291,7 +293,15 @@ tab_tlg_server <- function(id) { #' for mysterious reasons nav_select() and updateTabsetPanel() were not working, #' so solved this using JavaScript shinyjs::runjs( - paste0("$(`#", session$ns("tlg_tabs"), " a[data-value='Graphs']`)[0].click();") + paste0(" + // change the tab to graphs // + $(`#", session$ns("tlg_tabs"), " a[data-value='Graphs']`)[0].click(); + + // enable spinner, as it was disabled for initial empty UI render // + setTimeout(function() { + $('.tlg-plot-module .load-container').css('opacity', 1); + }, 500); + ") ) }) }) diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R index 9ce0403..780b1e1 100644 --- a/inst/shiny/modules/tlg_plot.R +++ b/inst/shiny/modules/tlg_plot.R @@ -83,7 +83,10 @@ tlg_plot_server <- function(id, render_plot, options = NULL) { #' updating current page based on user input observeEvent(input$next_page, current_page(current_page() + 1)) observeEvent(input$previous_page, current_page(current_page() - 1)) - observeEvent(input$select_page, current_page(as.numeric(input$select_page))) + observeEvent(input$select_page, { + if (input$select_page == "") return(NULL) + current_page(as.numeric(input$select_page)) + }) #' hold reactive information about the page layout num_pages <- reactive({ @@ -93,6 +96,7 @@ tlg_plot_server <- function(id, render_plot, options = NULL) { plots_per_page <- reactive({ if (is.null(input$plots_per_page)) return(NULL) + if (is.null(plot_list())) return(NULL) if (input$plots_per_page == "All") { isolate(length(plot_list())) } else { @@ -120,6 +124,8 @@ tlg_plot_server <- function(id, render_plot, options = NULL) { #' keeps list of plots to render, with options gathered from the UI and applied plot_list <- reactive({ + if (length(options_()) == 0) return(NULL) + plot_options <- purrr::list_modify(list(data = data()), !!!options_()) purrr::iwalk(plot_options, \(value, name) { From d1eb925e7f5ff0eb216ea093b16b79cb29bcc2d4 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Wed, 8 Jan 2025 16:06:05 +0100 Subject: [PATCH 85/93] feat: added btn-page class to buttons in accordance to #157 --- inst/shiny/modules/tlg_plot.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/inst/shiny/modules/tlg_plot.R b/inst/shiny/modules/tlg_plot.R index 780b1e1..f014b27 100644 --- a/inst/shiny/modules/tlg_plot.R +++ b/inst/shiny/modules/tlg_plot.R @@ -50,7 +50,7 @@ tlg_plot_ui <- function(id) { choices = c("All", 1, 2, 4, 6, 8, 10) ) ), - shinyjs::disabled(actionButton(ns("previous_page"), "Previous Page")) + shinyjs::disabled(actionButton(ns("previous_page"), "Previous Page", class = "btn-page")) ), div( align = "center", @@ -66,7 +66,7 @@ tlg_plot_ui <- function(id) { uiOutput(ns("page_number"), inline = TRUE), ) ), - div(align = "right", actionButton(ns("next_page"), "Next Page")) + div(align = "right", actionButton(ns("next_page"), "Next Page", class = "btn-page")) ), shinycssloaders::withSpinner( uiOutput(ns("plots")) From 85306941836c703ce2d631c22d084817dd18b30e Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Wed, 8 Jan 2025 16:39:40 +0100 Subject: [PATCH 86/93] fix: modules breaking after the order is submitted for a second time --- R/run_app.R | 1 + inst/shiny/modules/tab_tlg.R | 5 +++-- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/R/run_app.R b/R/run_app.R index 588fb88..be05fef 100644 --- a/R/run_app.R +++ b/R/run_app.R @@ -22,6 +22,7 @@ #' @importFrom shinyFiles shinyDirChoose #' @importFrom shinyjqui orderInput updateOrderInput #' @importFrom shinyWidgets dropdown pickerInput switchInput updatePickerInput +#' @importFrom stringi stri_rand_strings #' @importFrom tools file_ext #' @importFrom utils read.csv write.csv #' @importFrom zip zipr diff --git a/inst/shiny/modules/tab_tlg.R b/inst/shiny/modules/tab_tlg.R index f11ccf9..f74a260 100644 --- a/inst/shiny/modules/tab_tlg.R +++ b/inst/shiny/modules/tab_tlg.R @@ -272,10 +272,11 @@ tab_tlg_server <- function(id) { panels <- lapply(tlg_order_graphs, function(g_id) { plot_ui <- { g_def <- .TLG_DEFINITIONS[[g_id]] + module_id <- paste0(g_id, stringi::stri_rand_strings(1, 5)) if (exists(g_def$fun)) { - tlg_plot_server(g_id, get(g_def$fun), g_def$options) - tlg_plot_ui(session$ns(g_id)) + tlg_plot_server(module_id, get(g_def$fun), g_def$options) + tlg_plot_ui(session$ns(module_id)) } else { tags$div("Plot not implemented yet") } From 31f979e59cdc87b95b6225d38c89acaa11c56803 Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Wed, 8 Jan 2025 17:04:35 +0100 Subject: [PATCH 87/93] refactor: moved style to footer --- inst/shiny/modules/tab_tlg.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/inst/shiny/modules/tab_tlg.R b/inst/shiny/modules/tab_tlg.R index f74a260..f5e294b 100644 --- a/inst/shiny/modules/tab_tlg.R +++ b/inst/shiny/modules/tab_tlg.R @@ -53,7 +53,7 @@ tab_tlg_ui <- function(id) { nav_panel("Listings", "To be added"), nav_panel("Graphs", uiOutput(ns("graphs"), class = "tlg-plot-module"), value = "Graphs"), # disable loader for initial empty UI render # - tags$style(HTML(paste0(".tlg-plot-module .load-container {opacity: 0;}"))) + footer = tags$style(HTML(paste0(".tlg-plot-module .load-container {opacity: 0;}"))) ) } From a33e87dc411032be305a1326d5dd24763e612d04 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mateusz=20Ko=C5=82oma=C5=84ski?= <63905560+m-kolomanski@users.noreply.github.com> Date: Fri, 10 Jan 2025 15:40:56 +0100 Subject: [PATCH 88/93] style: remove whitespace Co-authored-by: Pavel Demin --- inst/shiny/www/style.css | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/inst/shiny/www/style.css b/inst/shiny/www/style.css index 02e9ba1..92266d7 100644 --- a/inst/shiny/www/style.css +++ b/inst/shiny/www/style.css @@ -187,7 +187,7 @@ } .plot-options-container { - & > button { + & > button { width: 75%; margin-left: 15%; margin-top: 1em; From fec4594f6af432d2d5fad492f0f9c09320585daf Mon Sep 17 00:00:00 2001 From: m-kolomanski Date: Fri, 10 Jan 2025 15:44:20 +0100 Subject: [PATCH 89/93] docs: being more direct about keys/ids that the user should provide --- .github/contributing/adding-tlg.md | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/contributing/adding-tlg.md b/.github/contributing/adding-tlg.md index 2c5e174..516fcb1 100644 --- a/.github/contributing/adding-tlg.md +++ b/.github/contributing/adding-tlg.md @@ -14,10 +14,10 @@ Currently not implemented ## Graphs ### yaml -The `Graph` entry should have the following format: +The `Graph` entry should have the following format. Identifying keys (wrapped in `<>`) should be provided by the creator and be unique within their scope (indentation level). ```yaml # unique identifier for given entry -id: +: # true / false whether TLG should be included as default is_default: # type of the TLG, in this case must be Graph @@ -37,7 +37,7 @@ id: # options that can be passed as arguments to the function options: # option id, the same as the argument that is passed to the rendering function, must be unique in the scope of the TLG entry - optid: +