teal
teal copied to clipboard
Published
20 hours ago •
insightsengineering
insightsengineering
Fix decorator problems after a good first run
Pull Request
Fixes #1511
Changes description
- Captures errors in
teal_transform_dataon initialization- Which should only be applicable to
decorators
- Which should only be applicable to
- Error is propagated downstream
🤖 Example app
options(
teal.log_level = "ERROR",
teal.show_js_log = TRUE,
# teal.bs_theme = bslib::bs_theme(version = 5),
shiny.bookmarkStore = "server"
)
pkgload::load_all("teal")
tm_decorated_plot <- function(label = "module", transformators = list(), decorators = list(), datanames = "all") {
checkmate::assert_list(decorators, "teal_transform_module")
module(
label = label,
ui = function(id, decorators) {
ns <- NS(id)
div(
selectInput(ns("dataname"), label = "select dataname", choices = NULL, multiple = TRUE),
selectInput(ns("x"), label = "select x", choices = NULL, multiple = TRUE),
selectInput(ns("y"), label = "select y", choices = NULL, multiple = TRUE),
ui_transform_teal_data(ns("decorate"), transformators = decorators),
plotOutput(ns("plot")),
verbatimTextOutput(ns("text"))
)
},
server = function(id, data, decorators) {
moduleServer(id, function(input, output, session) {
observeEvent(data(), {
dataname <- if (length(input$dataname)) input$dataname else names(data())[1]
updateSelectInput(inputId = "dataname", choices = names(data()), selected = dataname)
})
observeEvent(input$dataname, {
req(input$dataname)
updateSelectInput(inputId = "x", choices = colnames(data()[[input$dataname]]))
updateSelectInput(inputId = "y", choices = colnames(data()[[input$dataname]]))
})
dataname <- reactive(req(input$dataname))
x <- reactive({
req(input$x, input$x %in% colnames(data()[[dataname()]]))
input$x
})
y <- reactive({
req(input$y, input$y %in% colnames(data()[[dataname()]]))
input$y
})
plot_data <- reactive({
# todo: make sure it triggers once on init
# and once on change of its input and once on change in previous stages
req(dataname(), x(), y())
Sys.sleep(5) # to mimic relatively long computation
within(data(),
{
plot <- ggplot2::ggplot(dataname, ggplot2::aes(x = x, y = y)) +
ggplot2::geom_point()
},
dataname = as.name(dataname()),
x = as.name(x()),
y = as.name(y())
)
})
plot_data_decorated_no_print <- srv_transform_teal_data(
"decorate",
data = plot_data,
transformators = decorators
)
plot_data_decorated <- reactive(
within(req(plot_data_decorated_no_print()), expr = plot)
)
plot_r <- reactive({
plot_data_decorated()[["plot"]]
})
output$plot <- renderPlot(plot_r())
output$text <- renderText({
teal.code::get_code(req(plot_data_decorated()))
})
})
},
ui_args = list(decorators = decorators),
server_args = list(decorators = decorators),
datanames = datanames,
transformators = transformators
)
}
make_data <- function(datanames = c("ADSL", "ADTTE")) {
data_obj <- teal.data::teal_data()
if ("ADSL" %in% datanames) {
data_obj <- within(data_obj, ADSL <- teal.data::rADSL)
}
if ("ADTTE" %in% datanames) {
data_obj <- within(data_obj, ADTTE <- teal.data::rADTTE)
}
join_keys(data_obj) <- default_cdisc_join_keys[datanames]
data_obj
}
data <- teal_data_module(
once = FALSE,
ui = function(id) {
ns <- NS(id)
tagList(
selectizeInput(
ns("errortype"),
label = "Error Type",
choices = c(
"ok", "insufficient datasets", "no data",
"qenv.error", "error in reactive", "validate error", "silent.shiny.error", "not a reactive"
)
)
)
},
server = function(id, ...) {
moduleServer(id, function(input, output, session) {
logger::log_trace("example_module_transform2 initializing.")
reactive({
switch(input$errortype,
ok = make_data(),
`insufficient datasets` = make_data(datanames = "ADSL"),
`no data` = teal_data(),
qenv.error = within(data(), stop("\nthis is qenv.error in teal_data_module\n")),
`error in reactive` = stop("\nerror in a reactive in teal_data_module\n"),
`validate error` = validate(need(FALSE, "\nvalidate error in teal_data_module\n")),
`silent.shiny.error` = req(FALSE)
)
})
})
}
)
trans <- teal_transform_module(
ui = function(id) {
ns <- NS(id)
tagList(
selectizeInput(
ns("errortype"),
label = "Error Type",
choices = c(
"ok", "insufficient datasets", "no data",
"qenv.error", "error in reactive", "validate error", "silent.shiny.error", "not a reactive"
)
)
)
},
server = function(id, data) {
moduleServer(id, function(input, output, session) {
logger::log_trace("example_module_transform2 initializing.")
# to check if data with error causes problems
data2 <- reactive(data())
data3 <- eventReactive(data2(), data2())
observeEvent(data3(), {
# do nothing
})
reactive({
# notes: make sure it:
# - triggers once on init
# - once on change of its input
# - once on change in data input
new_data <- switch(input$errortype,
ok = data3(),
`insufficient datasets` = data3()["ADSL"],
`no data` = teal_data(),
qenv.error = within(teal_data(), stop("\nthis is qenv.error in teal_transform_module\n")),
`error in reactive` = stop("\nerror in a reactive in teal_transform_module\n"),
`validate error` = validate(need(FALSE, "\nvalidate error in teal_transform_module\n")),
`silent.shiny.error` = req(FALSE)
)
new_data
})
})
}
)
trans_empty <- teal_transform_module(
server = function(id, data) {
moduleServer(id, function(input, output, session) {
reactive({
validate(need(nrow(data()$ADSL) > 250, "ADSL needs 250 rows"))
data()
})
})
}
)
decor <- teal_transform_module(
label = "X-axis decorator",
ui = function(id) {
ns <- NS(id)
tagList(
selectizeInput(
ns("action"),
label = "Action type",
choices = c(
"nothing", "decorate", "no data",
"qenv.error", "error in reactive", "validate error", "silent.shiny.error", "not a reactive"
)
)
)
},
server = function(id, data) {
moduleServer(id, function(input, output, session) {
logger::log_trace("example_module_transform2 initializing.")
reactive({
switch(input$action,
nothing = data(),
`decorate` = data() |> within(plot <- plot + ggplot2::ggtitle("Decorated Title")),
`no data` = teal_data(),
qenv.error = within(teal_data(), stop("\nthis is qenv.error in teal_transform_module\n")),
`error in reactive` = stop("\nerror in a reactive in teal_transform_module\n"),
`validate error` = validate(need(FALSE, "\nvalidate error in teal_transform_module\n")),
`silent.shiny.error` = req(FALSE)
)
})
})
}
)
app <- teal::init(
data = data,
modules = modules(
modules(
label = "first tab",
tm_decorated_plot(
"mod-2",
transformators = list(trans, trans, trans_empty),
decorators = list(decor, decor),
datanames = c("ADSL", "ADTTE")
),
example_module()
)
),
filter = teal_slices(
teal_slice("ADSL", "SEX"),
teal_slice("ADSL", "AGE", selected = c(18L, 65L)),
teal_slice("ADTTE", "PARAMCD", selected = "CRSD"),
include_varnames = list(
ADSL = c("SEX", "AGE")
)
)
)
runApp(app)
This PR will minimize the srv_decorate_teal_data function definition repeated in {tmc} and {tmg}.
Unit Test Performance Difference
| Test Suite | $Status$ | Time on main |
$±Time$ | $±Tests$ | $±Skipped$ | $±Failures$ | $±Errors$ |
|---|---|---|---|---|---|---|---|
| shinytest2-disable_report | 💀 | $0.39$ | $-0.39$ | $-4$ | $-4$ | $0$ | $0$ |
| shinytest2-disable_src | 💀 | $0.19$ | $-0.19$ | $-2$ | $-2$ | $0$ | $0$ |
| shinytest2-show-rcode | 💀 | $0.28$ | $-0.28$ | $-3$ | $-3$ | $0$ | $0$ |
| shinytest2-teal_modifiers | 💀 | $0.53$ | $-0.53$ | $-7$ | $-7$ | $0$ | $0$ |
Additional test case details
| Test Suite | $Status$ | Time on main |
$±Time$ | Test Case |
|---|---|---|---|---|
| shinytest2-decorators | 👶 | $+0.03$ | unnamed | |
| shinytest2-disable_report | 💀 | $0.11$ | $-0.11$ | Add_to_report_button_is_not_disabled_by_default. |
| shinytest2-disable_report | 💀 | $0.09$ | $-0.09$ | Report_button_is_active_on_a_nested_module_by_default |
| shinytest2-disable_report | 💀 | $0.09$ | $-0.09$ | Report_button_is_disabled_on_a_module_changed_by_disable_report_ |
| shinytest2-disable_report | 💀 | $0.09$ | $-0.09$ | Report_button_is_disabled_on_nested_modules_changed_by_disable_report_ |
| shinytest2-disable_src | 💀 | $0.09$ | $-0.09$ | Show_R_Code_button_is_disabled_on_a_module |
| shinytest2-disable_src | 💀 | $0.10$ | $-0.10$ | Show_R_Code_is_disabled_on_nested_modules_changed_with_disable_src |
| shinytest2-reporter | 👶 | $+0.02$ | unnamed | |
| shinytest2-show-rcode | 💀 | $0.09$ | $-0.09$ | e2e_Module_with_Show_R_Code_has_code |
| shinytest2-show-rcode | 💀 | $0.09$ | $-0.09$ | e2e_Module_with_Show_R_Code_has_modal_with_two_dismiss_and_two_copy_to_clipboard_buttons |
| shinytest2-show-rcode | 💀 | $0.10$ | $-0.10$ | e2e_Module_with_Show_R_Code_initializes_with_visible_button |
| shinytest2-teal_data_module | 👶 | $+0.02$ | unnamed | |
| shinytest2-teal_modifiers | 💀 | $0.09$ | $-0.09$ | e2e_add_landing_modal_displays_landing_modal_on_app_startup |
| shinytest2-teal_modifiers | 💀 | $0.07$ | $-0.07$ | e2e_add_landing_modal_modal_can_be_dismissed |
| shinytest2-teal_modifiers | 💀 | $0.07$ | $-0.07$ | e2e_combined_modifiers_displays_all_customizations_when_chained_together |
| shinytest2-teal_modifiers | 💀 | $0.07$ | $-0.07$ | e2e_modify_footer_displays_custom_footer_in_the_app |
| shinytest2-teal_modifiers | 💀 | $0.07$ | $-0.07$ | e2e_modify_header_displays_custom_header_in_the_app |
| shinytest2-teal_modifiers | 💀 | $0.07$ | $-0.07$ | e2e_modify_title_sets_custom_title_in_the_page_title_head_title_displays_custom_favicon_in_the_app |
| shinytest2-teal_modifiers | 💀 | $0.08$ | $-0.08$ | e2e_modify_title_sets_custom_title_in_the_page_title_head_title_displays_custom_title_in_the_app |
Results for commit 45147c845c83e5cbe07e0bd44394a21edd5958a0
♻️ This comment has been updated with latest results.
![github-actions[bot] avatar](https://avatars.githubusercontent.com/in/15368?v=4 "Published by a pub.dev verified publisher"){kind=small}
Code Coverage Summary
Filename Stmts Miss Cover Missing
------------------------------ ------- ------ ------- --------------------------------------------------------------------------------------------------------------------------------------
R/after.R 59 21 64.41% 42-52, 64, 69, 77-79, 81-89, 100, 104-105
R/checkmate.R 24 0 100.00%
R/dummy_functions.R 61 2 96.72% 44, 46
R/include_css_js.R 11 0 100.00%
R/init.R 152 1 99.34% 299
R/landing_popup_module.R 34 10 70.59% 44-53
R/module_bookmark_manager.R 153 117 23.53% 54-58, 78-133, 138-139, 151, 198, 233-310
R/module_data_summary.R 177 8 95.48% 40, 50, 205, 236-240
R/module_filter_data.R 64 0 100.00%
R/module_filter_manager.R 229 50 78.17% 72-81, 89-94, 107-111, 116-117, 290-313, 339, 366, 378, 385-386
R/module_init_data.R 84 6 92.86% 38-43
R/module_nested_tabs.R 364 37 89.84% 163, 267-282, 302-306, 324, 361, 472-475, 479-482, 486-489, 534
R/module_session_info.R 18 0 100.00%
R/module_snapshot_manager.R 271 194 28.41% 103-112, 120-144, 163-164, 181-210, 214-229, 231-238, 245-275, 279, 283-287, 289-295, 298-311, 314-322, 352-366, 369-380, 383-397, 410
R/module_source_code.R 69 0 100.00%
R/module_teal_data.R 149 76 48.99% 43-149
R/module_teal_lockfile.R 131 53 59.54% 45-57, 60-62, 76, 86-88, 100-102, 110-119, 122, 124, 126-127, 142-146, 161-162, 177-186
R/module_teal_reporter.R 122 9 92.62% 60, 77-78, 81, 98, 128, 142, 144, 158
R/module_teal_with_splash.R 33 33 0.00% 24-61
R/module_teal.R 213 28 86.85% 130, 134-135, 145-146, 186, 204-220, 222, 255-256, 263-264
R/module_transform_data.R 134 7 94.78% 56, 116, 149-153
R/modules.R 291 51 82.47% 170-174, 229-232, 356-376, 384, 390, 567-573, 586-594, 609-624
R/reporter_previewer_module.R 41 41 0.00% 22-85
R/show_rcode_modal.R 31 31 0.00% 17-49
R/tdata.R 14 14 0.00% 19-61
R/teal_data_module-eval_code.R 23 0 100.00%
R/teal_data_module-within.R 7 0 100.00%
R/teal_data_module.R 20 0 100.00%
R/teal_data_utils.R 49 0 100.00%
R/teal_modifiers.R 57 0 100.00%
R/teal_slices-store.R 29 0 100.00%
R/teal_slices.R 63 0 100.00%
R/teal_transform_module.R 45 0 100.00%
R/TealAppDriver.R 298 298 0.00% 50-621
R/utils.R 291 48 83.51% 402-451, 539-548
R/validate_inputs.R 32 0 100.00%
R/validations.R 58 37 36.21% 114-392
R/zzz.R 19 15 21.05% 4-22
TOTAL 3920 1187 69.72%
Diff against main
Filename Stmts Miss Cover
------------------------- ------- ------ -------
R/module_nested_tabs.R -7 0 -0.19%
R/module_transform_data.R +18 +1 -0.05%
TOTAL +11 +1 +0.06%
Results for commit: d7f553cd3b28dd4838caad910648a4de16bd0f81
Minimum allowed coverage is 80%
:recycle: This comment has been updated with latest results
Unit Tests Summary
1 files 25 suites 2m 31s ⏱️ 315 tests 265 ✅ 50 💤 0 ❌ 522 runs 468 ✅ 54 💤 0 ❌
Results for commit d7f553cd.
:recycle: This comment has been updated with latest results.
📑 Journal (rolling update):
- (non-documented)
- Use
validate(need(...))instead ofstop()for better shiny handling in module - Q: Keep
"trigger on success"in summary data?- Seems to me that this should be less reactive to errors in transforms
Note: UI changes about placement and what should show where should be discussed #1509
Latest screenshot
Older screenshots
_(nothing to see here yet)_
@llrs-roche this is not forgotten, @gogonzo wants to add some functionality on top after we get an understanding of teal_report new data structure
I was checking the board and I don't know were we stay on this PR/feature. The coments I left on the review are minor and at the time I thought it could be merged. Do we merge this @gogonzo ?
I was checking the board and I don't know were we stay on this PR/feature. The comments I left on the review are minor and at the time I thought it could be merged. Do we merge this @gogonzo ?
PR was not enough as reason of failure lays deeper. I'd expect making a solution which can standardize error handling and would rather remove lines than add. There was one PR at that time I raised but I'm sceptical if anybody will review that anytime soon. I don't have capacity to handle this topic now :/
I was checking the board and I don't know were we stay on this PR/feature. The comments I left on the review are minor and at the time I thought it could be merged. Do we merge this @gogonzo ?
PR was not enough as reason of failure lays deeper. I'd expect making a solution which can standardize error handling and would rather remove lines than add. There was one PR at that time I raised but I'm sceptical if anybody will review that anytime soon. I don't have capacity to handle this topic now :/
Sorry @llrs-roche I confused this PR with https://github.com/insightsengineering/teal/pull/1509 I'm fine with your merge decision if everything works. Please check-out an app below where you can test various failures config.
teal-app-failures
options(
teal.log_level = "ERROR",
teal.show_js_log = TRUE,
# teal.bs_theme = bslib::bs_theme(version = 5),
shiny.bookmarkStore = "server"
)
pkgload::load_all("teal")
tm_decorated_plot <- function(label = "module", transformators = list(), decorators = list(), datanames = "all") {
checkmate::assert_list(decorators, "teal_transform_module")
module(
label = label,
ui = function(id, decorators) {
ns <- NS(id)
div(
selectInput(ns("dataname"), label = "select dataname", choices = NULL, multiple = TRUE),
selectInput(ns("x"), label = "select x", choices = NULL, multiple = TRUE),
selectInput(ns("y"), label = "select y", choices = NULL, multiple = TRUE),
ui_transform_teal_data(ns("decorate"), transformators = decorators),
plotOutput(ns("plot")),
verbatimTextOutput(ns("text"))
)
},
server = function(id, data, decorators) {
moduleServer(id, function(input, output, session) {
observeEvent(data(), {
dataname <- if (length(input$dataname)) input$dataname else names(data())[1]
updateSelectInput(inputId = "dataname", choices = names(data()), selected = dataname)
})
observeEvent(input$dataname, {
req(input$dataname)
updateSelectInput(inputId = "x", choices = colnames(data()[[input$dataname]]))
updateSelectInput(inputId = "y", choices = colnames(data()[[input$dataname]]))
})
dataname <- reactive(req(input$dataname))
x <- reactive({
req(input$x, input$x %in% colnames(data()[[dataname()]]))
input$x
})
y <- reactive({
req(input$y, input$y %in% colnames(data()[[dataname()]]))
input$y
})
plot_data <- reactive({
# todo: make sure it triggers once on init
# and once on change of its input and once on change in previous stages
req(dataname(), x(), y())
Sys.sleep(5) # to mimic relatively long computation
within(data(),
{
plot <- ggplot2::ggplot(dataname, ggplot2::aes(x = x, y = y)) +
ggplot2::geom_point()
},
dataname = as.name(dataname()),
x = as.name(x()),
y = as.name(y())
)
})
plot_data_decorated_no_print <- srv_transform_teal_data(
"decorate",
data = plot_data,
transformators = decorators
)
plot_data_decorated <- reactive(
within(req(plot_data_decorated_no_print()), expr = plot)
)
plot_r <- reactive({
plot_data_decorated()[["plot"]]
})
output$plot <- renderPlot(plot_r())
output$text <- renderText({
teal.code::get_code(req(plot_data_decorated()))
})
})
},
ui_args = list(decorators = decorators),
server_args = list(decorators = decorators),
datanames = datanames,
transformators = transformators
)
}
make_data <- function(datanames = c("ADSL", "ADTTE")) {
data_obj <- teal.data::teal_data()
if ("ADSL" %in% datanames) {
data_obj <- within(data_obj, ADSL <- teal.data::rADSL)
}
if ("ADTTE" %in% datanames) {
data_obj <- within(data_obj, ADTTE <- teal.data::rADTTE)
}
join_keys(data_obj) <- default_cdisc_join_keys[datanames]
data_obj
}
data <- teal_data_module(
once = FALSE,
ui = function(id) {
ns <- NS(id)
tagList(
selectizeInput(
ns("errortype"),
label = "Error Type",
choices = c(
"ok", "insufficient datasets", "no data",
"qenv.error", "error in reactive", "validate error", "silent.shiny.error", "not a reactive"
)
)
)
},
server = function(id, ...) {
moduleServer(id, function(input, output, session) {
logger::log_trace("example_module_transform2 initializing.")
reactive({
switch(input$errortype,
ok = make_data(),
`insufficient datasets` = make_data(datanames = "ADSL"),
`no data` = teal_data(),
qenv.error = within(data(), stop("\nthis is qenv.error in teal_data_module\n")),
`error in reactive` = stop("\nerror in a reactive in teal_data_module\n"),
`validate error` = validate(need(FALSE, "\nvalidate error in teal_data_module\n")),
`silent.shiny.error` = req(FALSE)
)
})
})
}
)
trans <- teal_transform_module(
ui = function(id) {
ns <- NS(id)
tagList(
selectizeInput(
ns("errortype"),
label = "Error Type",
choices = c(
"ok", "insufficient datasets", "no data",
"qenv.error", "error in reactive", "validate error", "silent.shiny.error", "not a reactive"
)
)
)
},
server = function(id, data) {
moduleServer(id, function(input, output, session) {
logger::log_trace("example_module_transform2 initializing.")
# to check if data with error causes problems
data2 <- reactive(data())
data3 <- eventReactive(data2(), data2())
observeEvent(data3(), {
# do nothing
})
reactive({
# notes: make sure it:
# - triggers once on init
# - once on change of its input
# - once on change in data input
new_data <- switch(input$errortype,
ok = data3(),
`insufficient datasets` = data3()["ADSL"],
`no data` = teal_data(),
qenv.error = within(teal_data(), stop("\nthis is qenv.error in teal_transform_module\n")),
`error in reactive` = stop("\nerror in a reactive in teal_transform_module\n"),
`validate error` = validate(need(FALSE, "\nvalidate error in teal_transform_module\n")),
`silent.shiny.error` = req(FALSE)
)
new_data
})
})
}
)
trans_empty <- teal_transform_module(
server = function(id, data) {
moduleServer(id, function(input, output, session) {
reactive({
validate(need(nrow(data()$ADSL) > 250, "ADSL needs 250 rows"))
data()
})
})
}
)
decor <- teal_transform_module(
label = "X-axis decorator",
ui = function(id) {
ns <- NS(id)
tagList(
selectizeInput(
ns("action"),
label = "Action type",
choices = c(
"nothing", "decorate", "no data",
"qenv.error", "error in reactive", "validate error", "silent.shiny.error", "not a reactive"
)
)
)
},
server = function(id, data) {
moduleServer(id, function(input, output, session) {
logger::log_trace("example_module_transform2 initializing.")
reactive({
switch(input$action,
nothing = data(),
`decorate` = data() |> within(plot <- plot + ggplot2::ggtitle("Decorated Title")),
`no data` = teal_data(),
qenv.error = within(teal_data(), stop("\nthis is qenv.error in teal_transform_module\n")),
`error in reactive` = stop("\nerror in a reactive in teal_transform_module\n"),
`validate error` = validate(need(FALSE, "\nvalidate error in teal_transform_module\n")),
`silent.shiny.error` = req(FALSE)
)
})
})
}
)
app <- teal::init(
data = data,
modules = modules(
modules(
label = "first tab",
tm_decorated_plot(
"mod-2",
transformators = list(trans, trans, trans_empty),
decorators = list(decor, decor),
datanames = c("ADSL", "ADTTE")
),
example_module()
)
),
filter = teal_slices(
teal_slice("ADSL", "SEX"),
teal_slice("ADSL", "AGE", selected = c(18L, 65L)),
teal_slice("ADTTE", "PARAMCD", selected = "CRSD"),
include_varnames = list(
ADSL = c("SEX", "AGE")
)
)
)
runApp(app)
Thanks to the app, I reviewed this again:
Data summary is present even when there is an error on qenv:
Screenshot
Errors are duplicated for each transform module:
Screenshot
Error messages are different on the UI between the transform Data panel and the main panel:
Screenshot
Initial error pops a modal and then the summary data is different from what the error says:
Screenshots
In conclusion. it fixes the second issue (Last state is shown, be it an error or a plot) but fails to provide "consistent error messages in decorators". Not merging for now.
Summary of the meeting with @llrs-roche
Data summary is present even when there is an error on qenv:
It makes sense, the summary table should be reactive
Action: grey out the "no datasets to show" in summary table
Errors are duplicated for each transform module:
Plan: only show in transformators if the error occurred there
Error messages are different on the UI between the transform Data panel and the main panel:
The error should also appear in the main module UI
note from Lluis: see if namespace is wrong
Initial error pops a modal and then the summary data is different from what the error says:
Bug when there is no UI for the transfomators and it enters an error state
Expected result is for the pseudo-UI to be visible with the error showing
Extra mile would be to modify the notification when filters are removed due to incompatible datanames.
- "Some filters..." only when they are partially removed
- "All filters..." when all are removed