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.

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

introduce decorators for tm_missing_data #809

Conversation

m7pr
Copy link
Contributor

@m7pr m7pr commented Nov 22, 2024

Part of insightsengineering/teal#1370

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

@m7pr m7pr added the core label Nov 22, 2024
@m7pr m7pr marked this pull request as draft November 22, 2024 12:23
@m7pr m7pr marked this pull request as ready for review November 22, 2024 13:23
@m7pr m7pr changed the title WIP introduce decorators for tm_missing_data introduce decorators for tm_missing_data Nov 22, 2024
@m7pr m7pr requested a review from averissimo November 22, 2024 13:23
@m7pr
Copy link
Contributor Author

m7pr commented Nov 22, 2024

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.



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

Choose a reason for hiding this comment

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

I think there's a problem with this reactive.

Running with your example shows some errors

image

@@ -1029,7 +1053,26 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par
)
})

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

Choose a reason for hiding this comment

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

@m7pr I converted this PR to the new srv_transform_teal_data

@m7pr
Copy link
Contributor Author

m7pr commented Nov 22, 2024

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

unable to find an inherited method for functioneval_codefor signatureobject = "NULL", code = "{"
image

@m7pr
Copy link
Contributor Author

m7pr commented Nov 25, 2024

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
Copy link
Contributor Author

m7pr commented Nov 25, 2024

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

@averissimo
Copy link
Contributor

averissimo commented Nov 25, 2024

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.

image

# 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
Copy link
Contributor Author

m7pr commented Nov 25, 2024

Hey, I see this in the UI

image

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 functioneval_codefor signatureobject = "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>

#' @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) {
Copy link
Contributor

Choose a reason for hiding this comment

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

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):

  1. list of teal_transform_module (keep current list-like approach)
  2. 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
  3. 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.

Copy link
Contributor Author

Choose a reason for hiding this comment

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

@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

@@ -381,25 +409,30 @@ encoding_missing_data <- function(id, summary_per_patient = FALSE, ggtheme, data
),
value = FALSE
)
}
},
ui_decorate_teal_data(ns("dec_summary_plot"), decorators = subset_decorators("summary_plot", decorators))
Copy link
Contributor

Choose a reason for hiding this comment

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

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

Comment on lines +138 to +144
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)
}
}
Copy link
Contributor

Choose a reason for hiding this comment

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

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

@averissimo averissimo merged commit 18f1618 into 1187_decorate_output@main Nov 26, 2024
1 check passed
@averissimo averissimo deleted the tm_missing_data_module@1187_decorate_output@main branch November 26, 2024 11:04
@github-actions github-actions bot locked and limited conversation to collaborators Nov 26, 2024
Sign up for free to subscribe to this conversation on GitHub. Already have an account? Sign in.
Labels
Projects
None yet
Development

Successfully merging this pull request may close these issues.

2 participants