diff --git a/NEWS.md b/NEWS.md index d8cb1e7fd..51033eb97 100644 --- a/NEWS.md +++ b/NEWS.md @@ -64,6 +64,7 @@ ## Bugs fixed +* Exploration plots no longer shrink middle-row subplots when faceting by many levels (e.g. USUBJID). Plot height now scales dynamically with the number of facet panels (#1283) * Fixed ratio calculations with `Aggregate Subject = yes` or `if-needed` not aggregating reference values, and ratio parameter columns (FABS, FREL, etc.) not appearing in NCA Results (#1273) * Last dose interval end time now extends to the last observed sample instead of being cut off at TRTRINT (tau), ensuring all collected data points are included in NCA calculations (#1235) * Fixed NA `PPSTRESU` handling across NCA results: descriptive statistics no longer crash when a parameter group has all-NA units, and manual interval parameters (e.g., RCAMINT) no longer get `NA` appended to their column names (#1216) diff --git a/inst/shiny/modules/tab_explore.R b/inst/shiny/modules/tab_explore.R index b175b5451..f18c427a7 100644 --- a/inst/shiny/modules/tab_explore.R +++ b/inst/shiny/modules/tab_explore.R @@ -1,6 +1,28 @@ # The Exploration Navbar tab loads the data from the Data tab, and results from NCA tab # The user can then explore the data using various visualisation tools +#' Compute plotly height that scales with the number of facet panels. +#' Returns NULL (plotly default) when there are few panels, so small +#' plots are unaffected. +#' @param p A ggplot object, possibly with facet_wrap. +#' @param row_height Pixel height per row of facet panels. +#' @param min_height Minimum height in pixels. +#' @noRd +.facet_plot_height <- function(p, row_height = 300, min_height = 500) { + facet <- p$facet + if (!inherits(facet, "FacetWrap")) { + return(NULL) + } + facet_vars <- names(facet$params$facets) + n_facets <- nrow(unique(p$data[facet_vars])) + if (is.null(n_facets) || n_facets <= 4) { + return(NULL) + } + ncol <- facet$params$ncol %||% ceiling(sqrt(n_facets)) + nrow <- ceiling(n_facets / ncol) + max(min_height, nrow * row_height) +} + # EXPLORATION ---- tab_explore_ui <- function(id) { ns <- NS(id) @@ -17,8 +39,8 @@ tab_explore_ui <- function(id) { is_mean_plot = FALSE, extra_ui = saved_outputs_ui(ns("saved_outputs_indiv")) ), - fillable = TRUE, - plotlyOutput(ns("individualplot"), height = "100%"), + fillable = FALSE, + plotlyOutput(ns("individualplot")), br(), br() ) ), @@ -30,8 +52,8 @@ tab_explore_ui <- function(id) { is_mean_plot = TRUE, extra_ui = saved_outputs_ui(ns("saved_outputs_mean")) ), - fillable = TRUE, - plotlyOutput(ns("mean_plot"), height = "100%"), + fillable = FALSE, + plotlyOutput(ns("mean_plot")), br(), br() ) ), @@ -108,7 +130,8 @@ tab_explore_server <- function(id, pknca_data, extra_group_vars) { # Render the individual plot in plotly output$individualplot <- renderPlotly({ req(individualplot()) - ggplotly(individualplot(), tooltip = "tooltip_text") + height <- .facet_plot_height(individualplot()) + ggplotly(individualplot(), tooltip = "tooltip_text", height = height) }) meanplot <- reactive({ @@ -161,7 +184,8 @@ tab_explore_server <- function(id, pknca_data, extra_group_vars) { # Render the mean plot output in plotly output$mean_plot <- renderPlotly({ req(meanplot()) - ggplotly(meanplot(), tooltip = "tooltip_text") + height <- .facet_plot_height(meanplot()) + ggplotly(meanplot(), tooltip = "tooltip_text", height = height) }) qc_plot_outputs <- pk_dose_qc_plot_server(