introduce decorators for tm_missing_data

[m7pr]

Part of insightsengineering/teal#1370

Working Example

pkgload::load_all("../teal")
pkgload::load_all(".")


footnote_dec <- teal_transform_module(
  label = "Footnote",
  ui = function(id) shiny::textInput(shiny::NS(id, "footnote"), "Footnote for Combination Plot", value = "I am a good decorator"),
  server = function(id, data) {
    moduleServer(id, function(input, output, session) {
      logger::log_info("🟢 Footnote called to action!", namespace = "teal.modules.general")
      reactive(
        within(
          data(),
          {
            footnote_str <- footnote
            if (exists('combination_plot_top')) {
              combination_plot_top <- combination_plot_top + ggplot2::labs(caption = footnote_str)
            }
          },
          footnote = input$footnote
        )
      )
    })
  }
)

# general example data
data <- teal_data()
data <- within(data, {
  require(nestcolor)
  
  add_nas <- function(x) {
    x[sample(seq_along(x), floor(length(x) * runif(1, .05, .17)))] <- NA
    x
  }
  
  iris <- iris
  mtcars <- mtcars
  
  iris[] <- lapply(iris, add_nas)
  mtcars[] <- lapply(mtcars, add_nas)
  mtcars[["cyl"]] <- as.factor(mtcars[["cyl"]])
  mtcars[["gear"]] <- as.factor(mtcars[["gear"]])
})

app <- init(
  data = data,
  modules = modules(
    tm_missing_data(decorators = list(footnote_dec))
  )
)
if (interactive()) {
  shinyApp(app$ui, app$server)
}

[m7pr]

This PR contains specific case where there is multiple outputs.
We exposed only one parameter called decorators that is applied to all output at the same time.
Since some outputs do not contain specific names, the example at the beginning of this conversation contains if(exists( statement, before the server code of the decorator is applied.

We need to think whether we expose N decorators for N outputs, or we expose one decorator parameter and make user to put if(exists around the server code of the decorator.

[averissimo]

I think there's a problem with this reactive.

Running with your example shows some errors

[averissimo]

@m7pr I converted this PR to the new srv_transform_teal_data

[m7pr]

Thanks @averissimo for some updates.
I still see some errors

unable to find an inherited method for function ‘eval_code’ for signature ‘object = "NULL", code = "{"’

[m7pr]

I think my example had an issue in the decorator.

I should use

            if (exists('combination_plot_top')) {
              combination_plot_top <- combination_plot_top + ggplot2::labs(caption = footnote_str)
            }

instead

            if (exists(combination_plot_top)) {
              combination_plot_top <- combination_plot_top + ggplot2::labs(caption = footnote_str)
            }

[m7pr]

Ok, I updated the example from the opening comment of this PR. Now it's ready to be merged

[averissimo]

There is a problem with this module when it has more than 1 decorator.

It doesn't appear in the UI, but an error is thrown on the console. I was investigating this, but couldn't understand last Friday

It is especially troubling as:

• This happens when decorators have code, or don't do anything (see code below).
  • You might have to navigate some or all of the tabs
• It doesn't happen if we provide the decorators individually.

# tm_missing_data

pkgload::load_all("../teal")
pkgload::load_all(".")

footnote_dec <- teal_transform_module(
  label = "Footnote",
  ui = function(id) shiny::textInput(shiny::NS(id, "footnote"), "Footnote for Combination Plot", value = "I am a good decorator"),
  server = function(id, data) {
    moduleServer(id, function(input, output, session) {
      logger::log_info("🟢 Footnote called to action!", namespace = "teal.modules.general")
      reactive(
        within(data(), {
          # footnote_str <- footnote
          # logger::log_info("🟢 {ls() |> paste(collapse = ', ')}", namespace = "teal.modules.general")
          # if (exists("combination_plot_top")) {
          #   combination_plot_top <- combination_plot_top + ggplot2::labs(caption = paste0(footnote_str, "1"))
          # }
          # if (exists("combination_plot_bottom")) {
          #   combination_plot_bottom <- combination_plot_bottom + ggplot2::labs(caption = paste0(footnote_str, "2"))
          # }
          # if (exists("summary_plot_top")) {
          #   summary_plot_top <- summary_plot_top + ggplot2::labs(caption = paste0(footnote_str, "3"))
          # }
          # if (exists("summary_plot_bottom")) {
          #   summary_plot_bottom <- summary_plot_bottom + ggplot2::labs(caption = paste0(footnote_str, "4"))
          # }
          # if (exists("by_subject_plot")) {
          #   by_subject_plot <- by_subject_plot + ggplot2::labs(caption = paste0(footnote_str, "5"))
          # }
        }, footnote = input$footnote)
      )
    })
  }
)

custom_table_decorator_interactive <- teal_transform_module(
  ui = function(id) {
    ns <- NS(id)
    div(
      selectInput(
        ns("style"), 
        "Table Style", 
        choices = c("Default", "Striped", "Hover"), 
        selected = "Default"
      )
    )
  },
  server = function(id, data) {
    moduleServer(id, function(input, output, session) {
      reactive({
        req(data(), input$style)
        within(data(), {
          # if (exists("table")) {
          #   style_str <- style
          #   logger::log_fatal("has table!! {style_str}", namespace = "teal.modules.general")
          #   if (style_str == "Striped") {
          #     table <- DT::formatStyle(
          #       table,
          #       columns = attr(table$x, "colnames")[-1],
          #       target = 'row',
          #       backgroundColor = '#f9f9f9'
          #     )
          #   } else if (style_str == "Hover") {
          #     table <- DT::formatStyle(
          #       table,
          #       columns = attr(table$x, "colnames")[-1],
          #       target = 'row',
          #       backgroundColor = '#f0f0f0'
          #     )
          #   }
          # }
        }, style = input$style)
      })
    })
  }
)

# CDISC example data
data <- teal_data()
data <- within(data, {
  require(nestcolor)
  ADSL <- rADSL
  ADRS <- rADRS
})
join_keys(data) <- default_cdisc_join_keys[names(data)]

app <- init(
  data = data,
  modules = modules(
    tm_missing_data(decorators = list(footnote_dec, custom_table_decorator_interactive))
    # tm_missing_data()
  )
)
if (interactive()) {
  shinyApp(app$ui, app$server)
}

[m7pr]

Hey, I see this in the UI

and this in the console

> if (interactive()) {
+   shinyApp(app$ui, app$server)
+ }

Listening on http://127.0.0.1:3983
[INFO] 2024-11-25 12:28:48.4902 pid:28152 token:[36a0678a] teal.modules.general 🟢 Footnote called to action!
[INFO] 2024-11-25 12:28:48.6028 pid:28152 token:[36a0678a] teal.modules.general 🟢 Footnote called to action!
[INFO] 2024-11-25 12:28:48.6588 pid:28152 token:[36a0678a] teal.modules.general 🟢 Footnote called to action!
[INFO] 2024-11-25 12:28:48.7131 pid:28152 token:[36a0678a] teal.modules.general 🟢 Footnote called to action!
[INFO] 2024-11-25 12:28:49.1373 pid:28152 token:[36a0678a] teal.modules.general 🟢 Footnote called to action!
[INFO] 2024-11-25 12:28:49.1858 pid:28152 token:[36a0678a] teal.modules.general 🟢 Footnote called to action!
[INFO] 2024-11-25 12:28:49.2427 pid:28152 token:[36a0678a] teal.modules.general 🟢 Footnote called to action!
[INFO] 2024-11-25 12:28:49.2951 pid:28152 token:[36a0678a] teal.modules.general 🟢 Footnote called to action!
Warning: Error in : unable to find an inherited method for function ‘eval_code’ for signature ‘object = "NULL", code = "{"’
  146: stop
  145: <Anonymous>
  144: eval_code
  143: within
  142: %>%
  141: <reactive:decorated_summary_plot_q> [C:/Rprojects/teal.modules.general/R/tm_missing_data.R#1230]
  125: decorated_summary_plot_q
  124: <reactive:summary_plot_r> [C:/Rprojects/teal.modules.general/R/tm_missing_data.R#1277]
  108: plot_r
   99: renderUI [C:/Rprojects/teal.widgets/R/plot_with_settings.R#401]
   98: func
   85: renderFunc
   84: output$teal-teal_modules-missing_data-module-ADSL-summary_plot-plot_out_main
    3: runApp
    2: print.shiny.appobj
    1: <Anonymous>