Skip to content

Commit 8c413a7

Browse files
m7prm7pr
authored
Merge branch 'main' into generalize-the-TealAppDriver@main
2 parents 9de19be + 67fe434 commit 8c413a7

16 files changed

+251
-295
lines changed

‎DESCRIPTION‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,8 @@
11
Type: Package
22
Package: teal
33
Title: Exploratory Web Apps for Analyzing Clinical Trials Data
4-
Version: 1.0.0.9012
5-
Date: 2025-10-10
4+
Version: 1.0.0.9015
5+
Date: 2025-10-15
66
Authors@R: c(
77
person("Dawid", "Kaledkowski", , "dawid.kaledkowski@roche.com", role = c("aut", "cre"),
88
comment = c(ORCID = "0000-0001-9533-457X")),

‎NEWS.md‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
# teal 1.0.0.9012
1+
# teal 1.0.0.9015
22

33
### New features
44

‎R/TealAppDriver.R‎

Lines changed: 60 additions & 151 deletions
Original file line numberDiff line numberDiff line change
@@ -146,7 +146,13 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
146146
set_input = function(input_id, value, ...) {
147147
do.call(
148148
self$set_inputs,
149-
c(setNames(list(value), input_id), list(...))
149+
c(
150+
setNames(
151+
list(value),
152+
input_id
153+
),
154+
list(...)
155+
)
150156
)
151157
invisible(self)
152158
},
@@ -170,74 +176,19 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
170176
invisible(self)
171177
},
172178
#' @description
173-
#' Get the active shiny name space for different components of the teal app.
174-
#'
175-
#' @return (`list`) The list of active shiny name space of the teal components.
176-
active_ns = function() {
177-
if (identical(private$ns$module, character(0))) {
178-
private$set_active_ns()
179-
}
180-
private$ns
181-
},
182-
#' @description
183-
#' Get the active shiny name space for interacting with the module content.
184-
#'
185-
#' @return (`string`) The active shiny name space of the component.
186-
active_module_ns = function() {
187-
if (identical(private$ns$module, character(0))) {
188-
private$set_active_ns()
189-
}
190-
private$ns$module
191-
},
192-
#' @description
193-
#' Get the active shiny name space bound with a custom `element` name.
194-
#'
195-
#' @param element `character(1)` custom element name.
196-
#'
197-
#' @return (`string`) The active shiny name space of the component bound with the input `element`.
198-
active_module_element = function(element) {
199-
checkmate::assert_string(element)
200-
sprintf("#%s-%s", self$active_module_ns(), element)
201-
},
202-
#' @description
203-
#' Get the text of the active shiny name space bound with a custom `element` name.
204-
#'
205-
#' @param element `character(1)` the text of the custom element name.
179+
#' `NS` in different sections of `teal` app
206180
#'
207-
#' @return (`string`) The text of the active shiny name space of the component bound with the input `element`.
208-
active_module_element_text = function(element) {
209-
checkmate::assert_string(element)
210-
self$get_text(self$active_module_element(element))
211-
},
212-
#' @description
213-
#' Get the active shiny name space for interacting with the filter panel.
181+
#' @param is_selector (`logical(1)`) whether `ns` function should prefix with `#`.
214182
#'
215-
#' @return (`string`) The active shiny name space of the component.
216-
active_filters_ns = function() {
217-
if (identical(private$ns$filter_panel, character(0))) {
218-
private$set_active_ns()
219-
}
220-
private$ns$filter_panel
221-
},
222-
#' @description
223-
#' Get the active shiny name space for interacting with the data-summary panel.
224-
#'
225-
#' @return (`string`) The active shiny name space of the data-summary component.
226-
active_data_summary_ns = function() {
227-
if (identical(private$ns$data_summary, character(0))) {
228-
private$set_active_ns()
183+
#' @return list of `ns`.
184+
namespaces = function(is_selector = FALSE) {
185+
ns_fun <- if (is_selector) {
186+
function(id) shiny::NS(sprintf("#%s", id))
187+
} else {
188+
shiny::NS
229189
}
230-
private$ns$data_summary
231-
},
232-
#' @description
233-
#' Get the active shiny name space bound with a custom `element` name.
234-
#'
235-
#' @param element `character(1)` custom element name.
236-
#'
237-
#' @return (`string`) The active shiny name space of the component bound with the input `element`.
238-
active_data_summary_element = function(element) {
239-
checkmate::assert_string(element)
240-
sprintf("#%s-%s", self$active_data_summary_ns(), element)
190+
191+
lapply(private$ns, ns_fun)
241192
},
242193
#' @description
243194
#' Get the input from the module in the `teal` app.
@@ -248,7 +199,7 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
248199
#' @return The value of the shiny input.
249200
get_active_module_input = function(input_id) {
250201
checkmate::check_string(input_id)
251-
self$get_value(input = sprintf("%s-%s", self$active_module_ns(), input_id))
202+
self$get_value(input = self$namespaces()$module(input_id))
252203
},
253204
#' @description
254205
#' Get the output from the module in the `teal` app.
@@ -259,7 +210,7 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
259210
#' @return The value of the shiny output.
260211
get_active_module_output = function(output_id) {
261212
checkmate::check_string(output_id)
262-
self$get_value(output = sprintf("%s-%s", self$active_module_ns(), output_id))
213+
self$get_value(output = self$namespaces()$module(output_id))
263214
},
264215
#' @description
265216
#' Get the output from the module's `teal.widgets::table_with_settings` or `DT::DTOutput` in the `teal` app.
@@ -274,7 +225,7 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
274225
checkmate::check_number(which, lower = 1)
275226
checkmate::check_string(table_id)
276227
table <- rvest::html_table(
277-
self$get_html_rvest(self$active_module_element(table_id)),
228+
self$get_html_rvest(self$namespaces(TRUE)$module(table_id)),
278229
fill = TRUE
279230
)
280231
if (length(table) == 0) {
@@ -293,7 +244,7 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
293244
get_active_module_plot_output = function(plot_id) {
294245
checkmate::check_string(plot_id)
295246
self$get_attr(
296-
self$active_module_element(sprintf("%s-plot_main > img", plot_id)),
247+
self$namespaces()$module(sprintf("%s-plot_main > img", plot_id)),
297248
"src"
298249
)
299250
},
@@ -310,7 +261,7 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
310261
checkmate::check_string(input_id)
311262
checkmate::check_string(value)
312263
self$set_input(
313-
sprintf("%s-%s", self$active_module_ns(), input_id),
264+
self$namespaces()$module(input_id),
314265
value,
315266
...
316267
)
@@ -322,7 +273,7 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
322273
#' Get the active datasets that can be accessed via the filter panel of the current active teal module.
323274
get_active_filter_vars = function() {
324275
displayed_datasets_index <- self$is_visible(
325-
sprintf("#%s-filters-filter_active_vars_contents > div > span", self$active_filters_ns())
276+
self$namespaces(TRUE)$filter_panel("filters-filter_active_vars_contents > div > span")
326277
)
327278

328279
js_code <- sprintf(
@@ -338,7 +289,7 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
338289
});
339290
textContents;
340291
",
341-
self$active_filters_ns()
292+
self$namespaces()$filter_panel(NULL)
342293
)
343294
available_datasets <- unlist(self$get_js(js_code))
344295

@@ -349,12 +300,14 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
349300
#' @return `data.frame`
350301
get_active_data_summary_table = function() {
351302
summary_table <- rvest::html_table(
352-
self$get_html_rvest(self$active_data_summary_element("table")),
303+
self$get_html_rvest(
304+
self$namespaces(TRUE)$data_summary("table")
305+
),
353306
fill = TRUE
354307
)[[1]]
355308

356-
col_names <- unlist(summary_table[1, ], use.names = FALSE)
357-
summary_table <- summary_table[-1, ]
309+
col_names <- unlist(summary_table[1, , drop = FALSE], use.names = FALSE)
310+
summary_table <- summary_table[-1, , drop = FALSE]
358311
colnames(summary_table) <- col_names
359312
if (nrow(summary_table) > 0) {
360313
summary_table
@@ -415,11 +368,7 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
415368
pattern = "\\s",
416369
replacement = "",
417370
self$get_text(
418-
sprintf(
419-
"#%s-filters-%s-container .filter-card-varname",
420-
self$active_filters_ns(),
421-
x
422-
)
371+
self$namespaces(TRUE)$filter_panel(sprintf("filters-%s-container .filter-card-varname", x))
423372
)
424373
)
425374
structure(
@@ -447,19 +396,10 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
447396
checkmate::check_string(var_name)
448397
private$set_active_ns()
449398
self$click(
450-
selector = sprintf(
451-
"#%s-filters-%s-add_filter_icon",
452-
private$ns$filter_panel,
453-
dataset_name
454-
)
399+
selector = self$namespaces(TRUE)$filter_panel(sprintf("filters-%s-add_filter_icon", dataset_name))
455400
)
456401
self$set_input(
457-
sprintf(
458-
"%s-filters-%s-%s-filter-var_to_add",
459-
private$ns$filter_panel,
460-
dataset_name,
461-
dataset_name
462-
),
402+
self$namespaces()$filter_panel(sprintf("filters-%1$s-%1$s-filter-var_to_add", dataset_name)),
463403
var_name,
464404
...
465405
)
@@ -478,23 +418,14 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
478418
checkmate::check_string(dataset_name, null.ok = TRUE)
479419
checkmate::check_string(var_name, null.ok = TRUE)
480420
if (is.null(dataset_name)) {
481-
remove_selector <- sprintf(
482-
"#%s-active-remove_all_filters",
483-
self$active_filters_ns()
484-
)
421+
remove_selector <- self$namespaces(TRUE)$filter_panel("active-remove_all_filters")
485422
} else if (is.null(var_name)) {
486-
remove_selector <- sprintf(
487-
"#%s-active-%s-remove_filters",
488-
self$active_filters_ns(),
489-
dataset_name
423+
remove_selector <- self$namespaces(TRUE)$filter_panel(
424+
sprintf("active-%s-remove_filters", dataset_name)
490425
)
491426
} else {
492-
remove_selector <- sprintf(
493-
"#%s-active-%s-filter-%s_%s-remove",
494-
self$active_filters_ns(),
495-
dataset_name,
496-
dataset_name,
497-
var_name
427+
remove_selector <- self$namespaces(TRUE)$filter_panel(
428+
sprintf("active-%1$s-filter-%1$s_%2$s-remove", dataset_name, var_name)
498429
)
499430
}
500431
self$click(
@@ -519,40 +450,28 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
519450
checkmate::check_string(var_name)
520451
checkmate::check_string(input)
521452

522-
input_id_prefix <- sprintf(
523-
"%s-filters-%s-filter-%s_%s-inputs",
524-
self$active_filters_ns(),
525-
dataset_name,
526-
dataset_name,
527-
var_name
453+
possible_id_suffix <- c(
454+
sprintf("filters-%1$s-filter-%1$s_%2$s-inputs-selection", dataset_name, var_name),
455+
sprintf("filters-%1$s-filter-%1$s_%2$s-inputs-selection_manual", dataset_name, var_name)
528456
)
529457

530-
# Find the type of filter (based on filter panel)
531-
supported_suffix <- c("selection", "selection_manual")
532-
slices_suffix <- supported_suffix[
533-
match(
534-
TRUE,
535-
vapply(
536-
supported_suffix,
537-
function(suffix) {
538-
!is.null(self$get_html(sprintf("#%s-%s", input_id_prefix, suffix)))
539-
},
540-
logical(1)
458+
# Find the type of filter (based on filter panel), filter_type[1=non-numeric; 2=numeric]
459+
slices_possible_selectors <- self$namespaces(TRUE)$filter_panel(possible_id_suffix)
460+
filter_type <- which(
461+
slices_possible_selectors %in%
462+
Filter(
463+
function(selector) !is.null(self$get_html(selector)),
464+
slices_possible_selectors
541465
)
542-
)
543-
]
544-
545-
# Generate correct namespace
546-
slices_input_id <- sprintf(
547-
"%s-filters-%s-filter-%s_%s-inputs-%s",
548-
self$active_filters_ns(),
549-
dataset_name,
550-
dataset_name,
551-
var_name,
552-
slices_suffix
553466
)
554467

555-
if (identical(slices_suffix, "selection_manual")) {
468+
if (identical(filter_type, 1L)) {
469+
self$set_input(
470+
self$namespaces()$filter_panel(possible_id_suffix[1]),
471+
input,
472+
...
473+
)
474+
} else if (identical(filter_type, 2L)) {
556475
checkmate::assert_numeric(input, len = 2)
557476

558477
dots <- rlang::list2(...)
@@ -562,7 +481,7 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
562481
self$run_js(
563482
sprintf(
564483
"Shiny.setInputValue('%s:sw.numericRange', [%f, %f], {priority: '%s'})",
565-
slices_input_id,
484+
self$namespaces()$filter_panel(possible_id_suffix[2]),
566485
input[[1]],
567486
input[[2]],
568487
priority_ = ifelse(is.null(dots$priority_), "input", dots$priority_)
@@ -574,12 +493,6 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
574493
timeout = if (is.null(dots$timeout_)) rlang::missing_arg() else dots$timeout_
575494
)
576495
}
577-
} else if (identical(slices_suffix, "selection")) {
578-
self$set_input(
579-
slices_input_id,
580-
input,
581-
...
582-
)
583496
} else {
584497
stop("Filter selection set not supported for this slice.")
585498
}
@@ -626,7 +539,7 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
626539
output = rlang::missing_arg(),
627540
export = rlang::missing_arg(),
628541
...) {
629-
ns <- shiny::NS(self$active_module_ns())
542+
ns <- self$namespaces()$module
630543

631544
if (!rlang::is_missing(input) && checkmate::test_string(input, min.chars = 1)) input <- ns(input)
632545
if (!rlang::is_missing(output) && checkmate::test_string(output, min.chars = 1)) output <- ns(output)
@@ -665,7 +578,7 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
665578
)
666579
active_base_id <- sub("-wrapper$", "", active_wrapper_id)
667580

668-
private$ns$module_container <- active_base_id
581+
private$ns$wrapper <- shiny::NS(active_base_id, "wrapper")
669582
private$ns$module <- shiny::NS(active_base_id, "module")
670583
private$ns$filter_panel <- shiny::NS(active_base_id, "filter_panel")
671584
private$ns$data_summary <- shiny::NS(active_base_id, "data_summary")
@@ -680,13 +593,9 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
680593
get_active_filter_selection = function(dataset_name, var_name) {
681594
checkmate::check_string(dataset_name)
682595
checkmate::check_string(var_name)
683-
input_id_prefix <- sprintf(
684-
"%s-filters-%s-filter-%s_%s-inputs",
685-
self$active_filters_ns(),
686-
dataset_name,
687-
dataset_name,
688-
var_name
689-
)
596+
input_id_prefix <- self$namespaces()$filter_panel(sprintf(
597+
"filters-%1$s-filter-%1$s_%2$s-inputs", dataset_name, var_name
598+
))
690599

691600
# Find the type of filter (categorical or range)
692601
supported_suffix <- c("selection", "selection_manual")

‎R/module_filter_data.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -62,7 +62,7 @@ srv_filter_data <- function(id, datasets, active_datanames, data, is_active) {
6262
)
6363
)
6464
filtered_code <- .get_filter_expr(datasets = datasets, datanames = datanames)
65-
filtered_teal_data <- .append_evaluated_code(data, filtered_code)
65+
filtered_teal_data <- .append_evaluated_code(data, code = filtered_code, filter_states = datasets$get_filter_state())
6666
filtered_datasets <- sapply(datanames, function(x) datasets$get_data(x, filtered = TRUE), simplify = FALSE)
6767
filtered_teal_data <- .append_modified_data(filtered_teal_data, filtered_datasets)
6868
filtered_teal_data

‎R/module_init_data.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -94,7 +94,7 @@ srv_init_data <- function(id, data) {
9494
if (!inherits(data, "teal_report")) {
9595
teal.reporter::teal_card(data_teal_report) <- c(
9696
teal.reporter::teal_card(),
97-
"## Code preparation",
97+
"## Data preparation",
9898
teal.reporter::teal_card(data_teal_report)
9999
)
100100
}

0 commit comments

Comments
 (0)