insightsengineering / insightsengineering/teal

[Bug]: decoration error state changes with first good run

Open
#1,511 2 comments 0 reactions 1 assignee Claimed by @averissimo View on GitHub
bug core
Dominant language
R
Stars
263
Forks
59
Avg merge
5d 17h
Merged PRs (30d)
5

Description

### What happened?

In 2 different ways after returning to an error state after being in a good one

1. Error messages in decorators are inconsistent
- Shown warning for 2^nd, 3^rd, ... saying that `"previous decorator failed"` (in initial state no warning were shown)
2. Code and plot are not updated to error state
- Last known good state is shown

_(see below on how to reproduce it)_:

![Image](https://github.com/user-attachments/assets/64bf9922-221f-4f95-b22e-9e3205858b8b)

##### How to reproduce either:

1. After selecting both `x` and `y`
2. Force an error state by removing `x` and `y`
3. Observe:
1. Error messages are different from initial state
2. Plot is still sown

Example App

```r
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(
style = "margin-left: 0.5em; margin-right: 0.5em;",
tags$em("(Encoding panel)", style = "margin-bottom: 0.5em; color: gray;"),
div(
style = "display: flex; gap: .2em;",
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),
# ui_module_validate(ns("validation")),
tags$h4("Plot data description"),
verbatimTextOutput(ns("description")),
tags$h4("Main plot"),
plotOutput(ns("plot")),
tags$h4("Code"),
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())
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())
)
})

extra_validation <- reactive(
validate(
need(
try(req(dataname(), x(), y()), silent = TRUE),
message = "(sample in-module usage) Please select dataname, x and y"
)
)
)
# srv_module_validate_validation("validation", extra_validation)

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$description <- renderPrint(print(req(plot_data_decorated())))
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
}

decor <- teal_transform_module(
label = "X-axis decorator",
ui = function(id) {
ns <- NS(id)
tags$em("A decorator")
},
server = function(id, data) {
moduleServer(id, function(input, output, session) {
logger::log_trace("example_module_transform2 initializing.")
reactive(data() |> within(plot <- plot + ggplot2::ggtitle("Decorated Title")))
})
}
)

teal::init(
data = make_data(),
modules = list(
tm_decorated_plot(
"mod-2",
# transformators = list(empty_ui_trans, trans, trans),
decorators = list(decor, decor),
datanames = c("ADSL", "ADTTE")
)
),
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()
```

### sessionInfo()

```R

```

### Relevant log output

```R

```

### Code of Conduct

- [x] I agree to follow this project's Code of Conduct.

### Contribution Guidelines

- [x] I agree to follow this project's Contribution Guidelines.

### Security Policy

- [x] I agree to follow this project's Security Policy.

Contributor guide

Open the contributing guide

Assessment

This issue has not been assessed yet.

Get new issues in your inbox

A short digest of beginner-friendly GitHub issues.