Skip to content

Commit c5b5e92

Browse files
gogonzogogonzo
authored
Merge d422b35 into 1d5045b 
2 parents 1d5045b + d422b35 commit c5b5e92

File tree

6 files changed

+81
-286
lines changed

6 files changed

+81
-286
lines changed

‎R/TealAppDriver.R‎

Lines changed: 60 additions & 151 deletions
Original file line numberDiff line numberDiff line change
@@ -136,7 +136,13 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
136136
set_input = function(input_id, value, ...) {
137137
do.call(
138138
self$set_inputs,
139-
c(setNames(list(value), input_id), list(...))
139+
c(
140+
setNames(
141+
list(value),
142+
input_id
143+
),
144+
list(...)
145+
)
140146
)
141147
invisible(self)
142148
},
@@ -160,74 +166,19 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
160166
invisible(self)
161167
},
162168
#' @description
163-
#' Get the active shiny name space for different components of the teal app.
164-
#'
165-
#' @return (`list`) The list of active shiny name space of the teal components.
166-
active_ns = function() {
167-
if (identical(private$ns$module, character(0))) {
168-
private$set_active_ns()
169-
}
170-
private$ns
171-
},
172-
#' @description
173-
#' Get the active shiny name space for interacting with the module content.
174-
#'
175-
#' @return (`string`) The active shiny name space of the component.
176-
active_module_ns = function() {
177-
if (identical(private$ns$module, character(0))) {
178-
private$set_active_ns()
179-
}
180-
private$ns$module
181-
},
182-
#' @description
183-
#' Get the active shiny name space bound with a custom `element` name.
184-
#'
185-
#' @param element `character(1)` custom element name.
186-
#'
187-
#' @return (`string`) The active shiny name space of the component bound with the input `element`.
188-
active_module_element = function(element) {
189-
checkmate::assert_string(element)
190-
sprintf("#%s-%s", self$active_module_ns(), element)
191-
},
192-
#' @description
193-
#' Get the text of the active shiny name space bound with a custom `element` name.
194-
#'
195-
#' @param element `character(1)` the text of the custom element name.
169+
#' `NS` in different sections of `teal` app
196170
#'
197-
#' @return (`string`) The text of the active shiny name space of the component bound with the input `element`.
198-
active_module_element_text = function(element) {
199-
checkmate::assert_string(element)
200-
self$get_text(self$active_module_element(element))
201-
},
202-
#' @description
203-
#' Get the active shiny name space for interacting with the filter panel.
171+
#' @param is_selector (`logical(1)`) whether `ns` function should prefix with `#`.
204172
#'
205-
#' @return (`string`) The active shiny name space of the component.
206-
active_filters_ns = function() {
207-
if (identical(private$ns$filter_panel, character(0))) {
208-
private$set_active_ns()
209-
}
210-
private$ns$filter_panel
211-
},
212-
#' @description
213-
#' Get the active shiny name space for interacting with the data-summary panel.
214-
#'
215-
#' @return (`string`) The active shiny name space of the data-summary component.
216-
active_data_summary_ns = function() {
217-
if (identical(private$ns$data_summary, character(0))) {
218-
private$set_active_ns()
173+
#' @return list of `ns`.
174+
namespaces = function(is_selector = FALSE) {
175+
ns_fun <- if (is_selector) {
176+
function(id) shiny::NS(sprintf("#%s", id))
177+
} else {
178+
shiny::NS
219179
}
220-
private$ns$data_summary
221-
},
222-
#' @description
223-
#' Get the active shiny name space bound with a custom `element` name.
224-
#'
225-
#' @param element `character(1)` custom element name.
226-
#'
227-
#' @return (`string`) The active shiny name space of the component bound with the input `element`.
228-
active_data_summary_element = function(element) {
229-
checkmate::assert_string(element)
230-
sprintf("#%s-%s", self$active_data_summary_ns(), element)
180+
181+
lapply(private$ns, ns_fun)
231182
},
232183
#' @description
233184
#' Get the input from the module in the `teal` app.
@@ -238,7 +189,7 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
238189
#' @return The value of the shiny input.
239190
get_active_module_input = function(input_id) {
240191
checkmate::check_string(input_id)
241-
self$get_value(input = sprintf("%s-%s", self$active_module_ns(), input_id))
192+
self$get_value(input = self$namespaces()$module(input_id))
242193
},
243194
#' @description
244195
#' Get the output from the module in the `teal` app.
@@ -249,7 +200,7 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
249200
#' @return The value of the shiny output.
250201
get_active_module_output = function(output_id) {
251202
checkmate::check_string(output_id)
252-
self$get_value(output = sprintf("%s-%s", self$active_module_ns(), output_id))
203+
self$get_value(output = self$namespaces()$module(output_id))
253204
},
254205
#' @description
255206
#' Get the output from the module's `teal.widgets::table_with_settings` or `DT::DTOutput` in the `teal` app.
@@ -264,7 +215,7 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
264215
checkmate::check_number(which, lower = 1)
265216
checkmate::check_string(table_id)
266217
table <- rvest::html_table(
267-
self$get_html_rvest(self$active_module_element(table_id)),
218+
self$get_html_rvest(self$namespaces(TRUE)$module(table_id)),
268219
fill = TRUE
269220
)
270221
if (length(table) == 0) {
@@ -283,7 +234,7 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
283234
get_active_module_plot_output = function(plot_id) {
284235
checkmate::check_string(plot_id)
285236
self$get_attr(
286-
self$active_module_element(sprintf("%s-plot_main > img", plot_id)),
237+
self$namespaces()$module(sprintf("%s-plot_main > img", plot_id)),
287238
"src"
288239
)
289240
},
@@ -300,7 +251,7 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
300251
checkmate::check_string(input_id)
301252
checkmate::check_string(value)
302253
self$set_input(
303-
sprintf("%s-%s", self$active_module_ns(), input_id),
254+
self$namespaces()$module(input_id),
304255
value,
305256
...
306257
)
@@ -312,7 +263,7 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
312263
#' Get the active datasets that can be accessed via the filter panel of the current active teal module.
313264
get_active_filter_vars = function() {
314265
displayed_datasets_index <- self$is_visible(
315-
sprintf("#%s-filters-filter_active_vars_contents > div > span", self$active_filters_ns())
266+
self$namespaces(TRUE)$filter_panel("filters-filter_active_vars_contents > div > span")
316267
)
317268

318269
js_code <- sprintf(
@@ -328,7 +279,7 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
328279
});
329280
textContents;
330281
",
331-
self$active_filters_ns()
282+
self$namespaces()$filter_panel(NULL)
332283
)
333284
available_datasets <- unlist(self$get_js(js_code))
334285

@@ -339,12 +290,14 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
339290
#' @return `data.frame`
340291
get_active_data_summary_table = function() {
341292
summary_table <- rvest::html_table(
342-
self$get_html_rvest(self$active_data_summary_element("table")),
293+
self$get_html_rvest(
294+
self$namespaces(TRUE)$data_summary("table")
295+
),
343296
fill = TRUE
344297
)[[1]]
345298

346-
col_names <- unlist(summary_table[1, ], use.names = FALSE)
347-
summary_table <- summary_table[-1, ]
299+
col_names <- unlist(summary_table[1, , drop = FALSE], use.names = FALSE)
300+
summary_table <- summary_table[-1, , drop = FALSE]
348301
colnames(summary_table) <- col_names
349302
if (nrow(summary_table) > 0) {
350303
summary_table
@@ -405,11 +358,7 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
405358
pattern = "\\s",
406359
replacement = "",
407360
self$get_text(
408-
sprintf(
409-
"#%s-filters-%s-container .filter-card-varname",
410-
self$active_filters_ns(),
411-
x
412-
)
361+
self$namespaces(TRUE)$filter_panel(sprintf("filters-%s-container .filter-card-varname", x))
413362
)
414363
)
415364
structure(
@@ -437,19 +386,10 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
437386
checkmate::check_string(var_name)
438387
private$set_active_ns()
439388
self$click(
440-
selector = sprintf(
441-
"#%s-filters-%s-add_filter_icon",
442-
private$ns$filter_panel,
443-
dataset_name
444-
)
389+
selector = self$namespaces(TRUE)$filter_panel(sprintf("filters-%s-add_filter_icon", dataset_name))
445390
)
446391
self$set_input(
447-
sprintf(
448-
"%s-filters-%s-%s-filter-var_to_add",
449-
private$ns$filter_panel,
450-
dataset_name,
451-
dataset_name
452-
),
392+
self$namespaces()$filter_panel(sprintf("filters-%1$s-%1$s-filter-var_to_add", dataset_name)),
453393
var_name,
454394
...
455395
)
@@ -468,23 +408,14 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
468408
checkmate::check_string(dataset_name, null.ok = TRUE)
469409
checkmate::check_string(var_name, null.ok = TRUE)
470410
if (is.null(dataset_name)) {
471-
remove_selector <- sprintf(
472-
"#%s-active-remove_all_filters",
473-
self$active_filters_ns()
474-
)
411+
remove_selector <- self$namespaces(TRUE)$filter_panel("active-remove_all_filters")
475412
} else if (is.null(var_name)) {
476-
remove_selector <- sprintf(
477-
"#%s-active-%s-remove_filters",
478-
self$active_filters_ns(),
479-
dataset_name
413+
remove_selector <- self$namespaces(TRUE)$filter_panel(
414+
sprintf("active-%s-remove_filters", dataset_name)
480415
)
481416
} else {
482-
remove_selector <- sprintf(
483-
"#%s-active-%s-filter-%s_%s-remove",
484-
self$active_filters_ns(),
485-
dataset_name,
486-
dataset_name,
487-
var_name
417+
remove_selector <- self$namespaces(TRUE)$filter_panel(
418+
sprintf("active-%1$s-filter-%1$s_%2$s-remove", dataset_name, var_name)
488419
)
489420
}
490421
self$click(
@@ -509,40 +440,28 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
509440
checkmate::check_string(var_name)
510441
checkmate::check_string(input)
511442

512-
input_id_prefix <- sprintf(
513-
"%s-filters-%s-filter-%s_%s-inputs",
514-
self$active_filters_ns(),
515-
dataset_name,
516-
dataset_name,
517-
var_name
443+
possible_id_suffix <- c(
444+
sprintf("filters-%1$s-filter-%1$s_%2$s-inputs-selection", dataset_name, var_name),
445+
sprintf("filters-%1$s-filter-%1$s_%2$s-inputs-selection_manual", dataset_name, var_name)
518446
)
519447

520-
# Find the type of filter (based on filter panel)
521-
supported_suffix <- c("selection", "selection_manual")
522-
slices_suffix <- supported_suffix[
523-
match(
524-
TRUE,
525-
vapply(
526-
supported_suffix,
527-
function(suffix) {
528-
!is.null(self$get_html(sprintf("#%s-%s", input_id_prefix, suffix)))
529-
},
530-
logical(1)
448+
# Find the type of filter (based on filter panel), filter_type[1=non-numeric; 2=numeric]
449+
slices_possible_selectors <- self$namespaces(TRUE)$filter_panel(possible_id_suffix)
450+
filter_type <- which(
451+
slices_possible_selectors %in%
452+
Filter(
453+
function(selector) !is.null(self$get_html(selector)),
454+
slices_possible_selectors
531455
)
532-
)
533-
]
534-
535-
# Generate correct namespace
536-
slices_input_id <- sprintf(
537-
"%s-filters-%s-filter-%s_%s-inputs-%s",
538-
self$active_filters_ns(),
539-
dataset_name,
540-
dataset_name,
541-
var_name,
542-
slices_suffix
543456
)
544457

545-
if (identical(slices_suffix, "selection_manual")) {
458+
if (identical(filter_type, 1L)) {
459+
self$set_input(
460+
self$namespaces()$filter_panel(possible_id_suffix[1]),
461+
input,
462+
...
463+
)
464+
} else if (identical(filter_type, 2L)) {
546465
checkmate::assert_numeric(input, len = 2)
547466

548467
dots <- rlang::list2(...)
@@ -552,7 +471,7 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
552471
self$run_js(
553472
sprintf(
554473
"Shiny.setInputValue('%s:sw.numericRange', [%f, %f], {priority: '%s'})",
555-
slices_input_id,
474+
self$namespaces()$filter_panel(possible_id_suffix[2]),
556475
input[[1]],
557476
input[[2]],
558477
priority_ = ifelse(is.null(dots$priority_), "input", dots$priority_)
@@ -564,12 +483,6 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
564483
timeout = if (is.null(dots$timeout_)) rlang::missing_arg() else dots$timeout_
565484
)
566485
}
567-
} else if (identical(slices_suffix, "selection")) {
568-
self$set_input(
569-
slices_input_id,
570-
input,
571-
...
572-
)
573486
} else {
574487
stop("Filter selection set not supported for this slice.")
575488
}
@@ -616,7 +529,7 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
616529
output = rlang::missing_arg(),
617530
export = rlang::missing_arg(),
618531
...) {
619-
ns <- shiny::NS(self$active_module_ns())
532+
ns <- self$namespaces()$module
620533

621534
if (!rlang::is_missing(input) && checkmate::test_string(input, min.chars = 1)) input <- ns(input)
622535
if (!rlang::is_missing(output) && checkmate::test_string(output, min.chars = 1)) output <- ns(output)
@@ -655,7 +568,7 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
655568
)
656569
active_base_id <- sub("-wrapper$", "", active_wrapper_id)
657570

658-
private$ns$module_container <- active_base_id
571+
private$ns$wrapper <- shiny::NS(active_base_id, "wrapper")
659572
private$ns$module <- shiny::NS(active_base_id, "module")
660573
private$ns$filter_panel <- shiny::NS(active_base_id, "filter_panel")
661574
private$ns$data_summary <- shiny::NS(active_base_id, "data_summary")
@@ -670,13 +583,9 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
670583
get_active_filter_selection = function(dataset_name, var_name) {
671584
checkmate::check_string(dataset_name)
672585
checkmate::check_string(var_name)
673-
input_id_prefix <- sprintf(
674-
"%s-filters-%s-filter-%s_%s-inputs",
675-
self$active_filters_ns(),
676-
dataset_name,
677-
dataset_name,
678-
var_name
679-
)
586+
input_id_prefix <- self$namespaces()$filter_panel(sprintf(
587+
"filters-%1$s-filter-%1$s_%2$s-inputs", dataset_name, var_name
588+
))
680589

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

0 commit comments

Comments
 (0)