Merge branch 'main' of https://github.com/insightsengineering/teal.go…

…shawk

.github/workflows/scheduled.yaml

@@ -81,6 +81,7 @@ jobs:
         insightsengineering/teal
         insightsengineering/teal.transform
         insightsengineering/teal.code
+        insightsengineering/teal.slice
         insightsengineering/teal.logger
         insightsengineering/teal.reporter
         insightsengineering/teal.widgets

DESCRIPTION

@@ -1,8 +1,8 @@
 Type: Package
 Package: teal.goshawk
 Title: Longitudinal Visualization `teal` Modules
-Version: 0.2.0.9010
-Date: 2024-10-07
+Version: 0.2.0.9013
+Date: 2024-10-09
 Authors@R: c(
     person("Nick", "Paszty", , "[email protected]", role = c("aut", "cre")),
     person("Dawid", "Kaledkowski", , "[email protected]", role = "aut"),

NEWS.md

@@ -1,4 +1,4 @@
-# teal.goshawk 0.2.0.9010
+# teal.goshawk 0.2.0.9013
 
 # teal.goshawk 0.2.0
 

R/tm_g_gh_boxplot.R

@@ -45,7 +45,7 @@
 #'
 #' @export
 #'
-#' @examples
+#' @examplesIf require("nestcolor")
 #' # Example using ADaM structure analysis dataset.
 #' data <- teal_data()
 #' data <- within(data, {
@@ -206,7 +206,6 @@ tm_g_gh_boxplot <- function(label,
     server_args = list(
       dataname = dataname,
       param_var = param_var,
-      trt_group = trt_group,
       color_manual = color_manual,
       shape_manual = shape_manual,
       plot_height = plot_height,
@@ -247,13 +246,6 @@ ui_g_boxplot <- function(id, ...) {
       teal.reporter::simple_reporter_ui(ns("simple_reporter")),
       ###
       templ_ui_dataname(a$dataname),
-      teal.widgets::optionalSelectInput(
-        ns("trt_group"),
-        label = "Select Treatment Variable",
-        choices = get_choices(a$trt_group$choices),
-        selected = a$trt_group$selected,
-        multiple = FALSE
-      ),
       uiOutput(ns("axis_selections")),
       templ_ui_constraint(ns, label = "Data Constraint"), # required by constr_anl_q
       if (length(a$hline_vars) > 0) {
@@ -323,6 +315,7 @@ srv_g_boxplot <- function(id,
       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)
+      resolved_trt <- teal.transform::resolve_delayed(module_args$trt_group, env)
 
       templ_ui_params_vars(
         session$ns,
@@ -336,7 +329,9 @@ srv_g_boxplot <- function(id,
         yselected = resolved_y$selected,
 
         facet_choices = resolved_facet_var$choices,
-        facet_selected = resolved_facet_var$selected
+        facet_selected = resolved_facet_var$selected,
+        trt_choices = resolved_trt$choices,
+        trt_selected = resolved_trt$selected
       )
     })
     # reused in all modules

R/tm_g_gh_correlationplot.R

@@ -255,7 +255,6 @@ tm_g_gh_correlationplot <- function(label,
     server_args = list(
       dataname = dataname,
       param_var = param_var,
-      trt_group = trt_group,
       trt_facet = trt_facet,
       color_manual = color_manual,
       shape_manual = shape_manual,
@@ -283,13 +282,6 @@ ui_g_correlationplot <- function(id, ...) {
       teal.reporter::simple_reporter_ui(ns("simple_reporter")),
       ###
       templ_ui_dataname(a$dataname),
-      teal.widgets::optionalSelectInput(
-        ns("trt_group"),
-        label = "Select Treatment Variable",
-        choices = get_choices(a$trt_group$choices),
-        selected = a$trt_group$selected,
-        multiple = FALSE
-      ),
       uiOutput(ns("axis_selections")),
       templ_ui_constraint(ns, "X-Axis Data Constraint"), # required by constr_anl_q
       if (length(a$hline_vars) > 0) {
@@ -388,6 +380,7 @@ srv_g_correlationplot <- function(id,
       resolved_x_var <- teal.transform::resolve_delayed(module_args$xaxis_var, env)
       resolved_y_param <- teal.transform::resolve_delayed(module_args$yaxis_param, env)
       resolved_y_var <- teal.transform::resolve_delayed(module_args$yaxis_var, env)
+      resolved_trt <- teal.transform::resolve_delayed(module_args$trt_group, env)
       templ_ui_params_vars(
         session$ns,
         xparam_choices = resolved_x_param$choices,
@@ -397,7 +390,9 @@ srv_g_correlationplot <- function(id,
         yparam_choices = resolved_y_param$choices,
         yparam_selected = resolved_y_param$selected,
         ychoices = resolved_y_var$choices,
-        yselected = resolved_y_var$selected
+        yselected = resolved_y_var$selected,
+        trt_choices = resolved_trt$choices,
+        trt_selected = resolved_trt$selected
       )
     })
 

R/tm_g_gh_density_distribution_plot.R

@@ -163,7 +163,6 @@ tm_g_gh_density_distribution_plot <- function(label, # nolint
       dataname = dataname,
       param_var = param_var,
       param = param,
-      trt_group = trt_group,
       color_manual = color_manual,
       color_comb = color_comb,
       plot_height = plot_height,
@@ -196,13 +195,6 @@ ui_g_density_distribution_plot <- function(id, ...) {
       teal.reporter::simple_reporter_ui(ns("simple_reporter")),
       ###
       templ_ui_dataname(a$dataname),
-      teal.widgets::optionalSelectInput(
-        ns("trt_group"),
-        label = "Select Treatment Variable",
-        choices = get_choices(a$trt_group$choices),
-        selected = a$trt_group$selected,
-        multiple = FALSE
-      ),
       uiOutput(ns("axis_selections")),
       templ_ui_constraint(ns, label = "Data Constraint"),
       ui_arbitrary_lines(id = ns("hline_arb"), a$hline_arb, a$hline_arb_label, a$hline_arb_color),
@@ -272,13 +264,17 @@ srv_g_density_distribution_plot <- function(id, # nolint
       env <- shiny::isolate(as.list(data()@env))
       resolved_x <- teal.transform::resolve_delayed(module_args$xaxis_var, env)
       resolved_param <- teal.transform::resolve_delayed(module_args$param, env)
+      resolved_trt <- teal.transform::resolve_delayed(module_args$trt_group, env)
+
       templ_ui_params_vars(
         session$ns,
         xparam_choices = resolved_param$choices,
         xparam_selected = resolved_param$selected,
         xparam_label = "Select a Biomarker",
         xchoices = resolved_x$choices,
-        xselected = resolved_x$selected
+        xselected = resolved_x$selected,
+        trt_choices = resolved_trt$choices,
+        trt_selected = resolved_trt$selected
       )
     })
 

R/tm_g_gh_lineplot.R

@@ -51,7 +51,7 @@
 #'
 #' @export
 #'
-#' @examples
+#' @examplesIf require("nestcolor")
 #' # Example using ADaM structure analysis dataset.
 #' data <- teal_data()
 #' data <- within(data, {
@@ -209,7 +209,6 @@ tm_g_gh_lineplot <- function(label,
     server_args = list(
       dataname = dataname,
       param_var = param_var,
-      trt_group = trt_group,
       color_manual = color_manual,
       xvar_level = xvar_level,
       trt_group_level = trt_group_level,
@@ -240,13 +239,6 @@ ui_lineplot <- function(id, ...) {
         teal.reporter::simple_reporter_ui(ns("simple_reporter")),
         ###
         templ_ui_dataname(a$dataname),
-        teal.widgets::optionalSelectInput(
-          ns("trt_group"),
-          label = "Select Treatment Variable",
-          choices = get_choices(a$trt_group$choices),
-          selected = a$trt_group$selected,
-          multiple = FALSE
-        ),
         uiOutput(ns("axis_selections")),
         uiOutput(ns("shape_ui")),
         radioButtons(ns("stat"), "Select a Statistic:", c("mean", "median"), a$stat),
@@ -363,6 +355,7 @@ srv_lineplot <- 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_trt <- teal.transform::resolve_delayed(module_args$trt_group, env)
       templ_ui_params_vars(
         ns,
         # xparam and yparam are identical, so we only show the user one
@@ -372,7 +365,9 @@ srv_lineplot <- function(id,
         xchoices = resolved_x$choices,
         xselected = resolved_x$selected,
         ychoices = resolved_y$choices,
-        yselected = resolved_y$selected
+        yselected = resolved_y$selected,
+        trt_choices = resolved_trt$choices,
+        trt_selected = resolved_trt$selected
       )
     })
 

R/tm_g_gh_scatterplot.R

@@ -172,7 +172,6 @@ tm_g_gh_scatterplot <- function(label,
     server_args = list(
       dataname = dataname,
       param_var = param_var,
-      trt_group = trt_group,
       trt_facet = trt_facet,
       color_manual = color_manual,
       shape_manual = shape_manual,
@@ -196,13 +195,6 @@ ui_g_scatterplot <- function(id, ...) {
       teal.reporter::simple_reporter_ui(ns("simple_reporter")),
       ###
       templ_ui_dataname(a$dataname),
-      teal.widgets::optionalSelectInput(
-        ns("trt_group"),
-        label = "Select Treatment Variable",
-        choices = get_choices(a$trt_group$choices),
-        selected = a$trt_group$selected,
-        multiple = FALSE
-      ),
       uiOutput(ns("axis_selections")),
       templ_ui_constraint(ns), # required by constr_anl_q
       teal.widgets::panel_group(
@@ -272,6 +264,7 @@ srv_g_scatterplot <- 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_trt <- teal.transform::resolve_delayed(module_args$trt_group, env)
       templ_ui_params_vars(
         session$ns,
         # xparam and yparam are identical, so we only show the user one
@@ -281,7 +274,9 @@ srv_g_scatterplot <- function(id,
         xchoices = resolved_x$choices,
         xselected = resolved_x$selected,
         ychoices = resolved_y$choices,
-        yselected = resolved_y$selected
+        yselected = resolved_y$selected,
+        trt_choices = resolved_trt$choices,
+        trt_selected = resolved_trt$selected
       )
     })
 

R/tm_g_gh_spaghettiplot.R

@@ -245,7 +245,6 @@ tm_g_gh_spaghettiplot <- function(label,
       dataname = dataname,
       idvar = idvar,
       param_var = param_var,
-      trt_group = trt_group,
       xaxis_var_level = xaxis_var_level,
       trt_group_level = trt_group_level,
       man_color = man_color,
@@ -278,13 +277,6 @@ g_ui_spaghettiplot <- function(id, ...) {
         teal.reporter::simple_reporter_ui(ns("simple_reporter")),
         ###
         templ_ui_dataname(a$dataname),
-        teal.widgets::optionalSelectInput(
-          ns("trt_group"),
-          label = "Select Treatment Variable",
-          choices = get_choices(a$trt_group$choices),
-          selected = a$trt_group$selected,
-          multiple = FALSE
-        ),
         uiOutput(ns("axis_selections")),
         radioButtons(
           ns("group_stats"),
@@ -381,6 +373,7 @@ srv_g_spaghettiplot <- 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_trt <- teal.transform::resolve_delayed(module_args$trt_group, env)
       templ_ui_params_vars(
         session$ns,
         # xparam and yparam are identical, so we only show the user one
@@ -390,7 +383,9 @@ srv_g_spaghettiplot <- function(id,
         xchoices = resolved_x$choices,
         xselected = resolved_x$selected,
         ychoices = resolved_y$choices,
-        yselected = resolved_y$selected
+        yselected = resolved_y$selected,
+        trt_choices = resolved_trt$choices,
+        trt_selected = resolved_trt$selected
       )
     })
 

R/toggleable_slider.R

@@ -31,6 +31,7 @@
 #'
 #' # use non-exported function from teal.goshawk
 #' toggle_slider_ui <- getFromNamespace("toggle_slider_ui", "teal.goshawk")
+#' toggle_slider_server <- getFromNamespace("toggle_slider_server", "teal.goshawk")
 #'
 #' ui <- div(
 #'   toggle_slider_ui(
@@ -213,6 +214,10 @@ toggle_slider_server <- function(id, is_dichotomous_slider = TRUE) {
         state_high$value <- state_high$value[[2]]
       }
       if (input$toggle %% 2 == 0) {
+        if (input$toggle > 0) {
+          state_slider$max <- max(state_slider$max, state_slider$value[2])
+          state_slider$min <- min(state_slider$min, state_slider$value[1])
+        }
         do.call(updateSliderInput, c(list(session, "slider"), state_slider))
       } else {
         if (length(state_slider$value) > 1) {

R/utils-templ_ui.r

@@ -30,6 +30,9 @@ templ_ui_params_vars <- function(ns,
                                  # facet_var
                                  facet_choices = NULL,
                                  facet_selected = NULL,
+                                 # trt_group
+                                 trt_choices = NULL,
+                                 trt_selected = NULL,
 
                                  multiple = FALSE) {
   if (is.null(xparam_choices) && !is.null(xchoices) && !is.null(yparam_choices)) {
@@ -40,6 +43,15 @@ templ_ui_params_vars <- function(ns,
     )
   }
   tagList(
+    if (!is.null(trt_choices)) {
+      teal.widgets::optionalSelectInput(
+        ns("trt_group"),
+        label = "Select Treatment Variable",
+        choices = trt_choices,
+        selected = trt_selected,
+        multiple = FALSE
+      )
+    },
     if (!is.null(xparam_choices)) {
       teal.widgets::optionalSelectInput(
         ns("xaxis_param"),