Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

654 pass reactive data@main #674

Merged
merged 15 commits into from
Jul 1, 2022
Merged

654 pass reactive data@main #674

Show file tree
Hide file tree
Changes from 4 commits
Commits
Show all changes
15 commits
Select commit Hold shift + click to select a range
b3a7443
enable teal_module to have data argument. Fix validation of module args
gogonzo Jun 23, 2022
4e90c77
combining code from FilteredData in separate function
gogonzo Jun 23, 2022
94675f9
pass data to the module (conditionally)
gogonzo Jun 23, 2022
8c64ad5
pass datasets conditionally to ui
gogonzo Jun 23, 2022
4557172
merge main
gogonzo Jun 27, 2022
3bfa652
Merge branch 'main' into 654_pass_reactive_data@main
gogonzo Jun 27, 2022
29f19a5
extend is_reporter_used to is_args_used
gogonzo Jun 28, 2022
bc95efc
static attributes
gogonzo Jun 28, 2022
72ee9b5
tests
gogonzo Jun 28, 2022
ca0919a
fix docs
gogonzo Jun 29, 2022
9561a36
@nikolas-burkoff
gogonzo Jun 30, 2022
c2cba18
@mhallal1 review
gogonzo Jul 1, 2022
6936035
@nikolas-burkoff review
gogonzo Jul 1, 2022
63ffd3c
add tests
gogonzo Jul 1, 2022
7d1c209
styler
gogonzo Jul 1, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions NEWS.md
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
# teal 0.11.1.9003

### Enhancements
* `teal_module` having `data` argument in it's arguments will receive list of reactive filter data with `"code"` and `"join_keys"` attributes.
* Enhanced the initial shiny input cycle, all encoding inputs are available from the beginning when each module server is executed.
* Updated the internals of `module_teal` to reflect changes in `teal.slice`.

Expand Down
136 changes: 59 additions & 77 deletions R/get_rcode.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -14,8 +14,6 @@
#' names of datasets which code should be returned for. Due to fact that
#' `teal` filter panel depending on `"ADSL"`, code for `ADSL`
#' is always returned even if not specified.
#' @param merge_expression (`character`)\cr
#' code to get merged analysis dataset
#' @param chunks (`chunks`) \cr
#' object of class `chunks` that stores code chunks. These code
#' chunks are used in [teal::teal] to enable reproducibility. Normally these chunks
Expand Down Expand Up @@ -50,7 +48,6 @@
#' title = "R Code for a Regression Plot",
#' rcode = get_rcode(
#' datasets = datasets,
#' merge_expression = "<to be provided>",
#' title = title,
#' description = description
#' )
Expand All @@ -59,20 +56,13 @@
#' @references [show_rcode_modal()], [get_rcode_header()]
get_rcode <- function(datasets = NULL,
datanames = `if`(is.null(datasets), datasets, datasets$datanames()),
merge_expression = "",
chunks = teal.code::get_chunks_object(),
selected_chunk_ids = character(0),
session = getDefaultReactiveDomain(),
title = NULL,
description = NULL) {
checkmate::assert_class(datasets, "FilteredData", null.ok = TRUE)
checkmate::assert_string(merge_expression)
if (merge_expression != "") {
message(paste0(
"'merge_expression' argument of 'get_rcode()' will be deprecated.",
" Please use 'chunks_push_data_merge()'."
))
}
if (!inherits(chunks, "chunks")) {
stop("No code chunks given")
}
Expand All @@ -81,84 +71,30 @@ get_rcode <- function(datasets = NULL,

rlang::push_options(width = 120)

progress <- Progress$new()
progress$set(message = "Getting R Code", value = 0)

if (!is.null(datasets)) {
if (inherits(datasets, "CDISCFilteredData")) {
datanames <- intersect(
datasets$datanames(),
unique(c(datanames, unlist(lapply(datanames, datasets$get_parentname))))
)
}

str_header <- get_rcode_header(title = title, description = description) %>%
paste0(collapse = "\n") %>%
paste0("\n")

progress <- Progress$new()
progress$set(message = "Getting R Code", value = 0)
str_install <- get_rcode_str_install() %>%
paste0(collapse = "\n") %>%
paste0("\n")

str_libs <- get_rcode_libraries() %>%
paste0("\n")

str_code <- datasets$get_code(datanames)
if (length(str_code) == 0 || (length(str_code) == 1 && str_code == "")) {
str_code <- paste0(c(
"#################################################################",
"# ___ ____ ____ ___ ____ ____ ____ ____ ____ ____ _ _ _ ____ #",
"# |__] |__/ |___ |__] |__/ | | | |___ [__ [__ | |\\ | | __ #",
"# | | \\ |___ | | \\ |__| |___ |___ ___] ___] | | \\| |__] #",
"# _ ____ ____ _ _ ___ ___ _ _ #",
"# | [__ |___ |\\/| |__] | \\_/ #",
"# | ___] |___ | | | | | #",
"#################################################################\n"
), collapse = "\n")
} else if (length(str_code) > 0) {
str_code <- paste0(str_code, "\n\n")
}
if (!datasets$get_check()) {
check_note_string <- paste0(
c(
"## NOTE: Reproducibility of data import and preprocessing was not",
"## explicitly checked (argument \"check = FALSE\" is set).",
"## The app developer has the choice to check the reproducibility",
"## and might have omitted this step for some reason. Please reach",
"## out to the app developer for details.\n"
),
collapse = "\n"
)
str_code <- paste0(str_code, "\n\n", check_note_string)
}

str_hash <- vapply(
datanames,
function(dataname) {
sprintf(
"# %s MD5 hash at the time of analysis: %s", dataname, datasets$get_filtered_dataset(dataname)$get_hash()
)
},
character(1)
) %>%
paste(collapse = "\n") %>%
paste0("\n\n")

str_filter <- teal.slice::get_filter_expr(datasets, datanames)
if (str_filter != "") {
str_filter <- paste0(str_filter, "\n\n")
}
str_header <- paste(
c(get_rcode_header(title = title, description = description), ""),
collapse = "\n"
)
str_install <- paste(c(get_rcode_str_install(), ""), collapse = "\n")
str_libs <- paste(get_rcode_libraries(), "\n")
str_code <- get_datasets_code(datanames, datasets)
} else {
str_header <- get_rcode_header(title = title, description = description)
str_install <- character(0)
str_libs <- character(0)
str_code <- character(0)
str_hash <- character(0)
str_filter <- character(0)
}


str_merge <- merge_expression

str_chunks <- paste0(
chunks$get_rcode(chunk_ids = selected_chunk_ids),
collapse = "\n"
Expand All @@ -178,9 +114,6 @@ get_rcode <- function(datasets = NULL,
code_to_style <- paste(
c(
str_code,
str_hash,
str_filter,
str_merge,
str_chunks,
"\n"
),
Expand All @@ -207,6 +140,55 @@ get_rcode <- function(datasets = NULL,
}


get_datasets_code <- function(datanames, datasets) {
str_code <- datasets$get_code(datanames)
if (length(str_code) == 0 || (length(str_code) == 1 && str_code == "")) {
str_code <- paste0(c(
"#################################################################",
"# ___ ____ ____ ___ ____ ____ ____ ____ ____ ____ _ _ _ ____ #",
"# |__] |__/ |___ |__] |__/ | | | |___ [__ [__ | |\\ | | __ #",
"# | | \\ |___ | | \\ |__| |___ |___ ___] ___] | | \\| |__] #",
"# _ ____ ____ _ _ ___ ___ _ _ #",
"# | [__ |___ |\\/| |__] | \\_/ #",
"# | ___] |___ | | | | | #",
"#################################################################\n"
), collapse = "\n")
} else if (length(str_code) > 0) {
str_code <- paste0(str_code, "\n\n")
}
if (!datasets$get_check()) {
check_note_string <- paste0(
c(
"## NOTE: Reproducibility of data import and preprocessing was not",
"## explicitly checked (argument \"check = FALSE\" is set).",
"## The app developer has the choice to check the reproducibility",
"## and might have omitted this step for some reason. Please reach",
"## out to the app developer for details.\n"
),
collapse = "\n"
)
str_code <- paste0(str_code, "\n\n", check_note_string)
}

str_hash <- vapply(
datanames,
function(dataname) {
sprintf(
"# %s MD5 hash at the time of analysis: %s", dataname, datasets$get_filtered_dataset(dataname)$get_hash()
)
},
character(1)
) %>%
paste(collapse = "\n") %>%
paste0("\n\n")

str_filter <- teal.slice::get_filter_expr(datasets, datanames)
if (str_filter != "") {
str_filter <- paste0(str_filter, "\n\n")
}
c(str_code, str_hash, str_filter)
}

## Module ----
#' Server part of get R code module
#'
Expand Down
46 changes: 37 additions & 9 deletions R/module_nested_tabs.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -68,11 +68,7 @@ ui_nested_tabs.teal_modules <- function(id, modules, datasets, depth = 0L) {
# by giving an id, we can reactively respond to tab changes
list(
id = ns("active_tab"),
type = if (modules$label == "root") "pills" else "tabs",
# select inexisting initially to not trigger reactive cycle
# tab is selected by js event after initialization of shiny inputs
# - see wait_for_element in init.js
selected = if (depth == 0L) "__none_selected" else NULL
type = if (modules$label == "root") "pills" else "tabs"
),
lapply(
names(modules$children),
Expand All @@ -94,7 +90,12 @@ ui_nested_tabs.teal_modules <- function(id, modules, datasets, depth = 0L) {
ui_nested_tabs.teal_module <- function(id, modules, datasets, depth = 0L) {
stopifnot(is(datasets, "FilteredData"))
args <- isolate(teal.transform::resolve_delayed(modules$ui_args, datasets))
args <- c(list(id = id, datasets = datasets), args)
args <- c(list(id = id), args)
is_datasets_used <- isTRUE("datasets" %in% names(formals(modules$ui)))
if (is_datasets_used) {
args <- c(args, datasets = datasets)
}

tags$div(
id = id,
class = "teal_module",
Expand Down Expand Up @@ -159,7 +160,6 @@ srv_nested_tabs.teal_modules <- function(id, datasets, modules, reporter) {

get_active_module <- reactive({
if (length(modules$children) == 1L) {
req(input$active_tab)
# single tab is active by default
modules_reactive[[1]]()
} else {
Expand Down Expand Up @@ -188,12 +188,40 @@ srv_nested_tabs.teal_module <- function(id, datasets, modules, reporter) {
module_reactive <- reactive({
modules$server_args <- teal.transform::resolve_delayed(modules$server_args, datasets)
is_module_server <- isTRUE("id" %in% names(formals(modules$server)))
args <- c(list(id = id, datasets = datasets), modules$server_args)

args <- c(list(id = id), modules$server_args)
if (is_reporter_used(modules)) {
args <- c(args, list(reporter = reporter))
}

is_datasets_used <- isTRUE("datasets" %in% names(formals(modules$server)))
if (is_datasets_used) {
args <- c(args, datasets = datasets)
}

is_data_used <- isTRUE("data" %in% names(formals(modules$server)))
Copy link
Contributor

@nikolas-burkoff nikolas-burkoff Jun 23, 2022 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

is_reporter_used works on module and modules objects (it's an S3 method) we should probably rename is_reporter_used to is_module_arg_used and pass in "reporter", "dataset", "id" etc. so we get consistent behaviour here?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Good point

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

we will need is_module_ui_arg_used and is_module_srv_arg_used to cover all scenarios. Or add an argument is_module_arg_used(..., type = "srv" or "ui").

if (is_data_used) {
datanames <- if (identical("all", modules$filter)) datasets$datanames() else modules$filter

# list of reactive filtered data
data <- sapply(
datanames,
simplify = FALSE,
function(x) {
#todo: need to include metadata, keys, datalabel
reactive(datasets$get_data(x, filtered = TRUE))
}
)
#names(data) <- paste0(names(data), "_FILTERED") # these datasets are filtered

# code from previous stages
attr(data, "code") <- reactive(get_datasets_code(datanames, datasets))

# join_keys
attr(data, "join_keys") <- reactive(datasets$get_join_keys()[datanames])

args <- c(args, data = list(data))
}

if (is_module_server) {
do.call(modules$server, args)
} else {
Expand Down
56 changes: 41 additions & 15 deletions R/modules.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -277,28 +277,54 @@ module <- function(label = "module",
checkmate::assert_function(server)
checkmate::assert_function(ui)
checkmate::assert_character(filters, min.len = 1, null.ok = TRUE, any.missing = FALSE)
checkmate::assert_list(server_args, null.ok = TRUE)
checkmate::assert_list(ui_args, null.ok = TRUE)
checkmate::assert_list(server_args, null.ok = TRUE, names = "named")
checkmate::assert_list(ui_args, null.ok = TRUE, names = "named")

server_main_args <- names(formals(server))
if (!(identical(server_main_args[1:4], c("input", "output", "session", "datasets")) ||
identical(server_main_args[1:2], c("id", "datasets")) || identical(server_main_args[1:2], c("id", "...")))) {
stop(paste(
"module() server argument requires a function with ordered arguments:",
"\ninput, output, session, and datasets (callModule) or id and [datasets or '...'] (moduleServer)"
))
server_formals <- names(formals(server))
if (!any(c("id", "input", "output", "session") %in% server_formals)) {
stop(
"\nmodule() `server` argument requires a function with following arguments:",
"\n - id - teal will set proper shiny namespace for this module.",
"\n - input, output, session (not recommended) - then shiny::callModules will be used to call a module.",
"\n\nFollowing arguments can be used optionaly:",
"\n - `data` - module will receive list of reactive (filtered) data specied in the `filters` argument",
"\n - `datasets` - module will receive `FilteredData`. See `help(FilteredData)`",
"\n - `reporter` - module will receive `Reporter`. See `help(teal.widgets::Reporter)`",
"\n - `filter_panel_api` - module will receive `FilterPanelApi`. See `help(FilterPanelApi)`",
"\n - `...` server_args elements will be passed to the module argument of the same name or to the `...`"
)
}

if (length(formals(ui)) < 2 ||
!identical(names(formals(ui))[[1]], "id") ||
!identical(names(formals(ui))[[2]], "datasets") && !identical(names(formals(ui))[[2]], "...")
) {
srv_extra_args <- setdiff(names(server_args), server_formals)
if (length(srv_extra_args) > 0 && !"..." %in% server_formals) {
stop(
"module() ui argument requires a function with two ordered arguments:",
"\n- 'id'\n- 'datasets' or '...'"
"\nFollowing `server_args` elements have no equivalent in the formals of `server`:\n",
paste(paste(" -", srv_extra_args), collapse = "\n"),
"\n\nUpdate the `server` arguments by including above or add `...`"
)
}

ui_formals <- names(formals(ui))
if (!"id" %in% ui_formals) {
stop(
"\nmodule() ui argument requires a function with following arguments:",
"\n - id - teala will set proper shiny namespace for this module.",
"\n\nFollowing arguments can be used optionaly:",
"\n - `data` - module will receive list of reactive (filtered) data specied in the `filters` argument",
"\n - `datasets` - module will receive `FilteredData`. See `help(FilteredData)`",
"\n - `...` ui_args elements will be passed to the module argument of the same name or to the `...`"
)
}

ui_extra_args <- setdiff(names(ui_args), ui_formals)
if (length(ui_extra_args) > 0 && !"..." %in% ui_formals) {
stop(
"\nFollowing `ui_args` elements have no equivalent in the formals of `ui`:\n",
paste(paste(" -", ui_extra_args), collapse = "\n"),
"\n\nUopdate the `ui` arguments by including above or add `...`"
)
}

structure(
list(
label = label,
Expand Down