introduce decorators for `tm_missing_data` #809

m7pr · 2024-11-22T12:22:50Z

Part of #863

Updated working example

# tm_missing_data

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

plot_grob_decorator <- function(default_footnote = "I am a good decorator", variable_to_replace = "summary_plot") {
  teal_transform_module(
    label = "Plot",
    ui = function(id) shiny::textInput(shiny::NS(id, "footnote"), "Footnote", value = default_footnote),
    server = function(id, data) {
      moduleServer(id, function(input, output, session) {
        logger::log_info("🟠 plot_grob with default: {default_footnote}!", namespace = "teal.modules.general")
        reactive({
          req(data(), input$footnote)
          logger::log_info("changing the footnote {default_footnote}", namespace = "teal.modules.general")
          teal.code::eval_code(data(), substitute(
            {
            footnote_grob <- grid::textGrob(footnote, x = 0, hjust = 0, gp = grid::gpar(fontsize = 10, fontface = "italic", col = "gray50"))
            
            # Arrange the plot and footnote
            variable_to_replace <- gridExtra::arrangeGrob(
              variable_to_replace,
              footnote_grob,
              ncol = 1,
              heights = grid::unit.c(grid::unit(1, "npc") - grid::unit(1, "lines"), grid::unit(1, "lines"))
            )
          }, 
          env = list(
            footnote = input$footnote,
            variable_to_replace = as.name(variable_to_replace)
          )))
        })
      })
    }
  )
}

caption_decorator <- teal_transform_module(
  ui = function(id) shiny::textInput(shiny::NS(id, "footnote"), "Footnote", value = "D"),
  server = make_teal_transform_server(
    expression(by_subject_plot <- by_subject_plot + ggplot2::labs(caption = footnote))
  )
)

table_decorator_interactive <- teal_transform_module(
  label = "Table",
  ui = function(id) {
    selectInput(
      NS(id, "style"), 
      "Table Style", 
      choices = c("Default", "Striped", "Hover"), 
      selected = "Default"
    )
  },
  server = function(id, data) {
    moduleServer(id, function(input, output, session) {
      logger::log_info("🔵 Footnote called to action!", namespace = "teal.modules.general")
      reactive({
        req(data(), input$style)
        within(data(), {
          style_str <- style
          table <- switch(
            style,
            "Striped" = DT::formatStyle(
              table,
              columns = attr(table$x, "colnames")[-1],
              target = 'row',
              backgroundColor = '#f9f9f9'
            ),
            "Hover" = DT::formatStyle(
              table,
              columns = attr(table$x, "colnames")[-1],
              target = 'row',
              backgroundColor = '#f0f0f0'
            ),
            table
          )
        }, style = input$style)
      })
    })
  }
)

generic_decorator <- teal_transform_module(
  ui = function(id) shiny::textInput(shiny::NS(id, "footnote"), "Footnote", value = "D"),
  server = make_teal_transform_server(
    expression({
      if (exists("by_subject_plot")) by_subject_plot <- by_subject_plot + ggplot2::labs(caption = footnote)
      if (exists("table", inherits = FALSE)) table <- DT::formatStyle(table, columns = attr(table$x, "colnames")[-1], target = 'row', backgroundColor = '#f9f9f9')
      if (exists("summary_plot")) {
        footnote_grob <- grid::textGrob(footnote, x = 0, hjust = 0, gp = grid::gpar(fontsize = 10, fontface = "italic", col = "gray50"))
        
        # Arrange the plot and footnote
        summary_plot <- gridExtra::arrangeGrob(summary_plot, footnote_grob, ncol = 1, heights = grid::unit.c(grid::unit(1, "npc") - grid::unit(1, "lines"), grid::unit(1, "lines")))
      }
      if (exists("combination_plot")) {
        footnote_grob <- grid::textGrob(footnote, x = 0, hjust = 0, gp = grid::gpar(fontsize = 10, fontface = "italic", col = "gray50"))
        
        # Arrange the plot and footnote
        combination_plot <- gridExtra::arrangeGrob(combination_plot, footnote_grob, ncol = 1, heights = grid::unit.c(grid::unit(1, "npc") - grid::unit(1, "lines"), grid::unit(1, "lines")))
      }
    })
  )
)

# 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(
      label = "Flat list",
      decorators = list(
        summary_plot = plot_grob_decorator("A"),
        combination_plot = plot_grob_decorator("B", "combination_plot"),
        summary_table = table_decorator_interactive,
        by_subject_plot = caption_decorator
      )
    ),
    tm_missing_data(
      label = "Complex list",
      decorators = list(
        summary_plot = list(plot_grob_decorator("A")),
        combination_plot = list(plot_grob_decorator("B", "combination_plot")),
        summary_table = list(table_decorator_interactive),
        by_subject_plot = list(caption_decorator)
      )
    ),
    tm_missing_data(
      label = "Complex list",
      decorators = list(generic_decorator)
    ),
    example_module()
  )
)
if (interactive()) {
  shinyApp(app$ui, app$server)
}

Old ~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)
}

…1187_decorate_output@main

m7pr · 2024-11-22T13:25:26Z

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 · 2024-11-22T14:46:55Z

R/tm_missing_data.R

+
+
+    decorated_summary_plot_q <- srv_transform_teal_data(id = "decorator", data = summary_plot_q, transformators = decorators)
+    decorated_summary_plot_grob_q <- reactive({


I think there's a problem with this reactive.

Running with your example shows some errors

averissimo · 2024-11-22T14:48:01Z

R/tm_missing_data.R

    })

-    combination_plot_r <- reactive(combination_plot_q()[["g"]])
+    decorated_combination_plot_q <- srv_transform_teal_data(id = "decorator", data = combination_plot_q, transformators = decorators)


@m7pr I converted this PR to the new srv_transform_teal_data

…1187_decorate_output@main

m7pr · 2024-11-22T18:24:42Z

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 = "{"’

…1187_decorate_output@main

m7pr · 2024-11-25T10:42:51Z

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 · 2024-11-25T10:44:27Z

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

averissimo · 2024-11-25T10:59:53Z

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 · 2024-11-25T11:30:27Z

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>

averissimo · 2024-11-26T07:44:12Z

R/utils.R

+#' @return A flat list with all decorators to include.
+#' It can be an empty list if none of the scope exists in `decorators` argument.
+#' @keywords internal
+subset_decorators <- function(scope, decorators) {


After A LOT of debugging I solved the issue on this module and I was rethinking our decision on relying on the same decorators for all "outputs".

I'm proposing we allow 3 types of values in decorators argument (similar to the initial code from a week and half ago):

list of teal_transform_module (keep current list-like approach)

Named list that can allow for customizations

list(default = list(...)) is protected and applies to all

list(summary_plot = list(...)) only applies decorator for summary_plot

Also allow named list of teal_transform_module

We could limit to just 1. and 2., or even just 2.. WDYT?

Why?

It seems odd to have all UIs on tm_missing_data, in particular, having plot-like decorators UI that do nothing on a table output.

Note: the PR also extracts the qenv generation from the main shiny module into smaller and logic-only modules. I opted for using modules instead of just passing input to keep with good Shiny practices.

@averissimo yeah, so I think we could meet and rethink. I actually am having still various thoughs on how we should to it, depending on how the module is built. I think the named list of decorators would be the most appriopiate. I wonder how that changes the server logic.

Thanks for working on this module and having this fixed

averissimo · 2024-11-26T07:45:42Z

R/tm_missing_data.R

        )
-      }
+      },
+      ui_decorate_teal_data(ns("dec_summary_plot"), decorators = subset_decorators("summary_plot", decorators))


subset_decorators("summary_plot", decorators) will return all from default plus the summary_plot related.

We can use either the names of the objects, or more generic ones

averissimo · 2024-11-26T07:46:33Z

R/tm_missing_data.R

+  if (checkmate::test_list(decorators, "teal_transform_module", null.ok = TRUE)) {
+    decorators <- if (checkmate::test_names(names(decorators), subset.of = c("default", available_decorators))) {
+      lapply(decorators, list)
+    } else {
+      list(default = decorators)
+    }
+  }


Conversion of decorators object if it is a flat list of teal_transform_module, it will preserve current behavior.

…1187_decorate_output@main

this is not there yet!

cca4193

m7pr added the core label Nov 22, 2024

m7pr marked this pull request as draft November 22, 2024 12:23

gogonzo mentioned this pull request Nov 22, 2024

Add decorators to all TMG modules #863

Closed

15 tasks

Merge branch '1187_decorate_output@main' into tm_missing_data_module@…

ad975fd

…1187_decorate_output@main

m7pr marked this pull request as ready for review November 22, 2024 13:23

m7pr changed the title ~~WIP introduce decorators for tm_missing_data~~ introduce decorators for tm_missing_data Nov 22, 2024

m7pr requested a review from averissimo November 22, 2024 13:23

m7pr assigned averissimo Nov 22, 2024

chore: rename ui/srv_teal_transform_data to ui/srv_transform_teal_data

8f0687b

averissimo reviewed Nov 22, 2024

View reviewed changes

averissimo added 2 commits November 22, 2024 16:03

Merge branch '1187_decorate_output@main' into tm_missing_data_module@…

e5f7864

…1187_decorate_output@main

fix: move all decoration to 1 chunk and fix problems

2c3c297

Merge branch '1187_decorate_output@main' into tm_missing_data_module@…

5a27da7

…1187_decorate_output@main

remove browser

314e06c

averissimo added 3 commits November 26, 2024 07:42

chore: cleanup and remove warning

524da4c

feat: add wrapper function

1368c2c

fix: error on module and add subset_decorator

4243950

averissimo reviewed Nov 26, 2024

View reviewed changes

Merge branch '1187_decorate_output@main' into tm_missing_data_module@…

06f938e

…1187_decorate_output@main

averissimo merged commit 18f1618 into 1187_decorate_output@main Nov 26, 2024
1 check passed

averissimo deleted the tm_missing_data_module@1187_decorate_output@main branch November 26, 2024 11:04

github-actions bot locked and limited conversation to collaborators Nov 26, 2024



		decorated_summary_plot_q <- srv_transform_teal_data(id = "decorator", data = summary_plot_q, transformators = decorators)
		decorated_summary_plot_grob_q <- reactive({

Uh oh!

introduce decorators for tm_missing_data #809

introduce decorators for tm_missing_data #809

Uh oh!

Conversation

m7pr commented Nov 22, 2024 • edited by averissimo Loading Uh oh! There was an error while loading. Please reload this page.

Uh oh!

Uh oh!

m7pr commented Nov 22, 2024

Uh oh!

averissimo Nov 22, 2024

Choose a reason for hiding this comment

Uh oh!

averissimo Nov 22, 2024

Choose a reason for hiding this comment

Uh oh!

m7pr commented Nov 22, 2024 • edited Loading Uh oh! There was an error while loading. Please reload this page.

Uh oh!

Uh oh!

m7pr commented Nov 25, 2024

Uh oh!

m7pr commented Nov 25, 2024

Uh oh!

averissimo commented Nov 25, 2024 • edited Loading Uh oh! There was an error while loading. Please reload this page.

Uh oh!

Uh oh!

m7pr commented Nov 25, 2024

Uh oh!

averissimo Nov 26, 2024

Choose a reason for hiding this comment

Why?

Uh oh!

m7pr Nov 26, 2024

Choose a reason for hiding this comment

Uh oh!

averissimo Nov 26, 2024

Choose a reason for hiding this comment

Uh oh!

averissimo Nov 26, 2024

Choose a reason for hiding this comment

Uh oh!

Uh oh!

Reviewers

Assignees

Labels

Projects

Milestone

Development

Uh oh!

3 participants

introduce decorators for `tm_missing_data` #809

introduce decorators for `tm_missing_data` #809

m7pr commented Nov 22, 2024 •

edited by averissimo

Loading

m7pr commented Nov 22, 2024 •

edited

Loading

averissimo commented Nov 25, 2024 •

edited

Loading