From 343b5f901f86079a77175ac5948196996c146719 Mon Sep 17 00:00:00 2001 From: m7pr Date: Fri, 4 Oct 2024 12:59:01 +0200 Subject: [PATCH 1/4] allow facet_var to be a delayed variables_choice for tm_g_gh_boxplot --- R/tm_g_gh_boxplot.R | 28 +++++++++++++--------------- R/utils-templ_ui.r | 13 +++++++++++++ 2 files changed, 26 insertions(+), 15 deletions(-) diff --git a/R/tm_g_gh_boxplot.R b/R/tm_g_gh_boxplot.R index a8dc415a..f28c1743 100644 --- a/R/tm_g_gh_boxplot.R +++ b/R/tm_g_gh_boxplot.R @@ -207,7 +207,6 @@ tm_g_gh_boxplot <- function(label, dataname = dataname, param_var = param_var, trt_group = trt_group, - facet_var = facet_var, color_manual = color_manual, shape_manual = shape_manual, plot_height = plot_height, @@ -256,13 +255,6 @@ ui_g_boxplot <- function(id, ...) { multiple = FALSE ), uiOutput(ns("axis_selections")), - teal.widgets::optionalSelectInput( - ns("facet_var"), - label = "Facet by", - choices = get_choices(a$facet_var$choices), - selected = a$facet_var$selected, - multiple = FALSE - ), templ_ui_constraint(ns, label = "Data Constraint"), # required by constr_anl_q if (length(a$hline_vars) > 0) { teal.widgets::optionalSelectInput( @@ -312,7 +304,6 @@ srv_g_boxplot <- function(id, dataname, param_var, trt_group, - facet_var, color_manual, shape_manual, plot_height, @@ -331,6 +322,8 @@ srv_g_boxplot <- function(id, resolved_x <- teal.transform::resolve_delayed(module_args$xaxis_var, env) resolved_y <- teal.transform::resolve_delayed(module_args$yaxis_var, env) resolved_param <- teal.transform::resolve_delayed(module_args$param, env) + resolved_facet_var <- teal.transform::resolve_delayed(module_args$facet_var, env) + templ_ui_params_vars( session$ns, xparam_choices = resolved_param$choices, @@ -338,8 +331,12 @@ srv_g_boxplot <- function(id, xparam_label = module_args$"Select a Biomarker", xchoices = resolved_x$choices, xselected = resolved_x$selected, + ychoices = resolved_y$choices, - yselected = resolved_y$selected + yselected = resolved_y$selected, + + facet_choices = resolved_facet_var$choices, + facet_selected = resolved_facet_var$selected ) }) # reused in all modules @@ -477,6 +474,7 @@ srv_g_boxplot <- function(id, xaxis_var <- input$yaxis_var # nolint font_size <- input$font_size trt_group <- input$trt_group + facet_var <- input$facet_var anl_q()$qenv %>% teal.code::eval_code( code = bquote({ @@ -486,7 +484,7 @@ srv_g_boxplot <- function(id, param_var = .(param_var), param = .(param), xaxis_var = .(xaxis_var), - facet_var = .(input$facet_var) + facet_var = .(facet_var) ) }) ) @@ -511,8 +509,8 @@ srv_g_boxplot <- function(id, numeric_cols <- setdiff(names(dplyr::select_if(tbl, is.numeric)), "n") DT::datatable(tbl, - rownames = FALSE, options = list(scrollX = TRUE), - callback = DT::JS("$.fn.dataTable.ext.errMode = 'none';") + rownames = FALSE, options = list(scrollX = TRUE), + callback = DT::JS("$.fn.dataTable.ext.errMode = 'none';") ) %>% DT::formatRound(numeric_cols, 4) }) @@ -581,8 +579,8 @@ srv_g_boxplot <- function(id, numeric_cols <- names(dplyr::select_if(df, is.numeric)) DT::datatable(df, - rownames = FALSE, options = list(scrollX = TRUE), - callback = DT::JS("$.fn.dataTable.ext.errMode = 'none';") + rownames = FALSE, options = list(scrollX = TRUE), + callback = DT::JS("$.fn.dataTable.ext.errMode = 'none';") ) %>% DT::formatRound(numeric_cols, 4) }) diff --git a/R/utils-templ_ui.r b/R/utils-templ_ui.r index 6d3ca49a..a0897e99 100644 --- a/R/utils-templ_ui.r +++ b/R/utils-templ_ui.r @@ -27,6 +27,10 @@ templ_ui_params_vars <- function(ns, ychoices = NULL, yselected = NULL, yvar_label = NULL, # variable, e.g. AVAL + # facet_var + facet_choices = NULL, + facet_selected = NULL, + multiple = FALSE) { if (is.null(xparam_choices) && !is.null(xchoices) && !is.null(yparam_choices)) { # otherwise, xchoices will appear first without any biomarker to select and this looks odd in the UI @@ -69,6 +73,15 @@ templ_ui_params_vars <- function(ns, ychoices, yselected, multiple = multiple ) + }, + if (!is.null(facet_choices)) { + teal.widgets::optionalSelectInput( + ns("facet_var"), + label = "Facet by", + choices = facet_choices, + selected = facet_selected, + multiple = FALSE + ) } ) } From 15854ed77ae11aa969a54d289b059008ab4b6347 Mon Sep 17 00:00:00 2001 From: m7pr Date: Thu, 10 Oct 2024 14:39:12 +0200 Subject: [PATCH 2/4] set default xlab to Analysis visit for lineplot and sphaghettiplot + allow to change them in Plot Settings panel --- R/tm_g_gh_lineplot.R | 10 +++++++++- R/tm_g_gh_spaghettiplot.R | 9 +++++++++ 2 files changed, 18 insertions(+), 1 deletion(-) diff --git a/R/tm_g_gh_lineplot.R b/R/tm_g_gh_lineplot.R index 6639250e..425e9c92 100644 --- a/R/tm_g_gh_lineplot.R +++ b/R/tm_g_gh_lineplot.R @@ -44,6 +44,7 @@ #' @param dot_size plot dot size. #' @param plot_relative_height_value numeric value between 500 and 5000 for controlling the starting value #' of the relative plot height slider +#' @param xlab an x-axis label, if \code{NULL} then the behavior as in `xlab` from \link[goshawk]{g_lineplot} #' @author Wenyi Liu (luiw2) wenyi.liu@roche.com #' @author Balazs Toth (tothb2) toth.balazs@gene.com #' @@ -147,6 +148,7 @@ tm_g_gh_lineplot <- function(label, )[1:4], xtick = ggplot2::waiver(), xlabel = xtick, + xlab = "Analysis Visit", rotate_xlab = FALSE, plot_height = c(600, 200, 4000), plot_width = NULL, @@ -201,6 +203,9 @@ tm_g_gh_lineplot <- function(label, # Validate line arguments validate_line_arb_arg(hline_arb, hline_arb_color, hline_arb_label) + # Validate character labels + checkmate::assert_string(xlab, null.ok = TRUE) + args <- as.list(environment()) module( @@ -277,7 +282,8 @@ ui_lineplot <- function(id, ...) { value = c(-1000000, 1000000) ), checkboxInput(ns("rotate_xlab"), "Rotate X-axis Label", a$rotate_xlab), - numericInput(ns("count_threshold"), "Contributing Observations Threshold:", a$count_threshold) + numericInput(ns("count_threshold"), "Contributing Observations Threshold:", a$count_threshold), + textInput(ns("xlab"), "X-axis Label", a$xlab) ), teal.widgets::panel_item( title = "Plot settings", @@ -720,6 +726,7 @@ srv_lineplot <- function(id, " ) } + xlab <- if (is.null(input$xlab)) xaxis else input$xlab hline_arb <- horizontal_line()$line_arb hline_arb_label <- horizontal_line()$line_arb_label @@ -749,6 +756,7 @@ srv_lineplot <- function(id, hline_arb_color = .(hline_arb_color), xtick = .(if (!is.null(xtick)) quote(xtick) else xtick), xlabel = .(if (!is.null(xtick)) quote(xlabel) else xlabel), + xlab = .(xlab), rotate_xlab = .(rotate_xlab), plot_height = .(relative_height), # in g_lineplot this is relative height of plot to table plot_font_size = .(plot_font_size), diff --git a/R/tm_g_gh_spaghettiplot.R b/R/tm_g_gh_spaghettiplot.R index 46d5344d..930d2c4b 100644 --- a/R/tm_g_gh_spaghettiplot.R +++ b/R/tm_g_gh_spaghettiplot.R @@ -46,6 +46,7 @@ #' @param hline_vars_colors a character vector naming the colors for the additional horizontal lines. #' @param hline_vars_labels a character vector naming the labels for the additional horizontal lines that will appear #' in the legend. +#' @param xlab an `x-axis` label, if \code{NULL} then no label is displayed #' @inheritParams teal.widgets::standard_layout #' #' @author Wenyi Liu (luiw2) wenyi.liu@roche.com @@ -176,6 +177,7 @@ tm_g_gh_spaghettiplot <- function(label, color_comb = NULL, xtick = ggplot2::waiver(), xlabel = xtick, + xlab = "Analysis Visit", rotate_xlab = FALSE, facet_ncol = 2, free_x = FALSE, @@ -236,6 +238,9 @@ tm_g_gh_spaghettiplot <- function(label, validate_line_arb_arg(hline_arb, hline_arb_color, hline_arb_label) validate_line_vars_arg(hline_vars, hline_vars_colors, hline_vars_labels) + # Validate character labels + checkmate::assert_string(xlab, null.ok = TRUE) + args <- as.list(environment()) module( @@ -320,6 +325,7 @@ g_ui_spaghettiplot <- function(id, ...) { ), checkboxInput(ns("free_x"), "Free X-Axis Scales", a$free_x), checkboxInput(ns("rotate_xlab"), "Rotate X-Axis Label", a$rotate_xlab), + textInput(ns("xlab"), "X-axis Label", a$xlab), teal.widgets::optionalSliderInputValMinMax(ns("font_size"), "Font Size", a$font_size, ticks = FALSE), teal.widgets::optionalSliderInputValMinMax(ns("dot_size"), "Dot Size", a$dot_size, ticks = FALSE), teal.widgets::optionalSliderInputValMinMax( @@ -474,6 +480,8 @@ srv_g_spaghettiplot <- function(id, ) } + xlab <- input$xlab + teal.code::eval_code( object = private_qenv, code = bquote({ @@ -498,6 +506,7 @@ srv_g_spaghettiplot <- function(id, hline_arb_color = .(hline_arb_color), xtick = xtick, xlabel = xlabel, + xlab = .(xlab), rotate_xlab = .(rotate_xlab), font_size = .(font_size), dot_size = .(dot_size), From 3f5dbcd5407004690122902da8081dcb3b338102 Mon Sep 17 00:00:00 2001 From: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Date: Thu, 10 Oct 2024 12:45:15 +0000 Subject: [PATCH 3/4] [skip style] [skip vbump] Restyle files --- R/tm_g_gh_boxplot.R | 2 -- R/tm_g_gh_lineplot.R | 2 +- 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/R/tm_g_gh_boxplot.R b/R/tm_g_gh_boxplot.R index a1f8227e..c44180ef 100644 --- a/R/tm_g_gh_boxplot.R +++ b/R/tm_g_gh_boxplot.R @@ -324,10 +324,8 @@ srv_g_boxplot <- function(id, xparam_label = module_args$"Select a Biomarker", xchoices = resolved_x$choices, xselected = resolved_x$selected, - ychoices = resolved_y$choices, yselected = resolved_y$selected, - facet_choices = resolved_facet_var$choices, facet_selected = resolved_facet_var$selected, trt_choices = resolved_trt$choices, diff --git a/R/tm_g_gh_lineplot.R b/R/tm_g_gh_lineplot.R index 425e9c92..dba4cbdd 100644 --- a/R/tm_g_gh_lineplot.R +++ b/R/tm_g_gh_lineplot.R @@ -726,7 +726,7 @@ srv_lineplot <- function(id, " ) } - xlab <- if (is.null(input$xlab)) xaxis else input$xlab + xlab <- if (is.null(input$xlab)) xaxis else input$xlab hline_arb <- horizontal_line()$line_arb hline_arb_label <- horizontal_line()$line_arb_label From 5a4ce41820bb35bb810863f5f7eb120e59af5c5a Mon Sep 17 00:00:00 2001 From: "27856297+dependabot-preview[bot]@users.noreply.github.com" <27856297+dependabot-preview[bot]@users.noreply.github.com> Date: Thu, 10 Oct 2024 12:49:58 +0000 Subject: [PATCH 4/4] [skip roxygen] [skip vbump] Roxygen Man Pages Auto Update --- man/tm_g_gh_lineplot.Rd | 3 +++ man/tm_g_gh_spaghettiplot.Rd | 3 +++ 2 files changed, 6 insertions(+) diff --git a/man/tm_g_gh_lineplot.Rd b/man/tm_g_gh_lineplot.Rd index c307d9b6..1d7e5933 100644 --- a/man/tm_g_gh_lineplot.Rd +++ b/man/tm_g_gh_lineplot.Rd @@ -26,6 +26,7 @@ tm_g_gh_lineplot( "#4ca3dd", "#8a2be2"))[1:4], xtick = ggplot2::waiver(), xlabel = xtick, + xlab = "Analysis Visit", rotate_xlab = FALSE, plot_height = c(600, 200, 4000), plot_width = NULL, @@ -90,6 +91,8 @@ Default value is waive().} \item{xlabel}{vector with same length of \code{xtick} to define the label of x-axis tick values. Default value is waive().} +\item{xlab}{an x-axis label, if \code{NULL} then the behavior as in \code{xlab} from \link[goshawk]{g_lineplot}} + \item{rotate_xlab}{\code{logical(1)} value indicating whether to rotate \code{x-axis} labels.} \item{plot_height}{controls plot height.} diff --git a/man/tm_g_gh_spaghettiplot.Rd b/man/tm_g_gh_spaghettiplot.Rd index 27a4bdf0..e79f3221 100644 --- a/man/tm_g_gh_spaghettiplot.Rd +++ b/man/tm_g_gh_spaghettiplot.Rd @@ -22,6 +22,7 @@ tm_g_gh_spaghettiplot( color_comb = NULL, xtick = ggplot2::waiver(), xlabel = xtick, + xlab = "Analysis Visit", rotate_xlab = FALSE, facet_ncol = 2, free_x = FALSE, @@ -83,6 +84,8 @@ when x variable is numeric. Default value is \code{waive()}.} \item{xlabel}{vector with same length of \code{xtick} to define the label of \code{x-axis} tick values. Default value is \code{waive()}.} +\item{xlab}{an \code{x-axis} label, if \code{NULL} then no label is displayed} + \item{rotate_xlab}{\code{logical(1)} value indicating whether to rotate \code{x-axis} labels} \item{facet_ncol}{numeric value indicating number of facets per row.}