modify plot resizing script

[chlebowa]

Slight modification that has no bearing on normal teal applications but makes it possible to properly resize plots in teal apps that are (re)embeded in parent shiny apps.
Related to insightsengineering/teal#1239

There are no changes to the logic, merely the implementation.

Simplified script that governs plot resizing by:

• declaring the callback function in a var
• adding namespace to event for which handlers are registered

This allows for the event handlers to be thoroughly and safely removed.

Note 1

The callback on shiny:connected seems unnecessary to me (plots resize just fine at any point in the run time) but I may be missing something.

Note 2

In the interest of keeping JS and R separately, the script could be rewritten as a JS function (stored in another file) that would be called here. This is not necessary in any way.

example app

library(shiny)
library(shinyjs)
library(teal)
library(teal.modules.general)
devtools::load_all("./teal.widgets")

rm(list = ls())

# generate incremented id for teal module call 
teal_module_id <- function(counter) {
  sprintf("teal_module_%i", counter)
}
# generate teal module ui and plac eit in a hidden div
teal_app_ui <- function(counter) {
  div(
    id = "teal_app_container",
    ui_teal_with_splash(
      id = teal_module_id(counter),
      data = teal_data()
    )
  ) |> hidden()
}

ui <- fluidPage(
  title = "teal app generator",
  useShinyjs(),
  # this panel switches between teal app configuration and inspection
  uiOutput("control_panel"),
  uiOutput("app_configuration"),
  div(id = "teal_app_inspection", teal_app_ui(0L)),
  NULL
)

server <- function(input, output, session) {
  # buttons to alternate between configuration and inspection screens
  output[["control_panel"]] <- renderUI({
    actionButton("master_button", label = "generate app") #|> disabled()
  })
  # configuration screen
  output[["app_configuration"]] <- renderUI({
    dataset_choices <- c("iris", "mtcars")
    module_choices <- c("tm_g_distribution", "tm_t_crosstable")
    div(
      id = "teal_app_controls",
      selectInput("datasets", "choose datasets", choices = dataset_choices, multiple = TRUE, selected = dataset_choices),
      selectizeInput("modules", "choose modules", choices = module_choices, multiple = TRUE, selected = module_choices)
    )
  })
  # disable master button if not ready to build app
  observe({
    toggleState("master_button", condition = isTruthy(input[["datasets"]]) && isTruthy(input[["modules"]]))
  })
  # inspection screen
  # app ui is wrapped in a div so that it has an id that can be toggled
  # teal module id is incremented on every inspection to avoid reusing observers
  teal_app_counter <- reactiveVal(0L)

  # build teal_data object for teal app
  # note this re-runs every time datasets change so it may cause performance problems as dataset code must be evaluated
  teal_app_data <- reactive({
    validate(need(input[["datasets"]], "select some datasets"))
    validate(need(input[["modules"]], "select some modules"))

    datasets <- mget(input$datasets, envir = as.environment("package:datasets"))
    datasets_code <- do.call(expression, lapply(sprintf("%s <- %s", input$datasets, input$datasets), str2lang))

    ans <- do.call("teal_data", c(datasets, list(code = datasets_code))) |> verify()
    ans <- within(ans, {
      for (v in c("cyl", "vs", "am", "gear")) {
        mtcars[[v]] <- as.factor(mtcars[[v]])
      }
      mtcars[["primary_key"]] <- seq_len(nrow(mtcars))
    })
    join_keys(ans) <- join_keys(join_key("mtcars", "mtcars", "primary_key"))
    ans
  })

  # build teal_modules object for teal app
  teal_app_modules <- reactive({
    req(input[["modules"]])

    module_funs <- mget(input$modules, mode = "function", inherits = TRUE)
    module_args <- lapply(input$modules, function(x) {
      switch(x,
        "example_module" = list(),
        "tm_g_distribution" = list(
          dist_var = data_extract_spec(
            dataname = "iris",
            select = select_spec(variable_choices("iris"), "Petal.Length")
          )
        ),
        "tm_g_response" = list(
          response = data_extract_spec(
            dataname = "mtcars",
            select = select_spec(
              label = "Select variable:",
              choices = variable_choices("mtcars", c("cyl", "gear")),
              selected = "cyl",
              multiple = FALSE,
              fixed = FALSE
            )
          ),
          x = data_extract_spec(
            dataname = "mtcars",
            select = select_spec(
              label = "Select variable:",
              choices = variable_choices("mtcars", c("vs", "am")),
              selected = "vs",
              multiple = FALSE,
              fixed = FALSE
            )
          )
        ),
        "tm_t_crosstable" = list(
          label = "Cross Table",
          x = data_extract_spec(
            dataname = "mtcars",
            select = select_spec(
              label = "Select variable:",
              choices = variable_choices("mtcars", c("cyl", "vs", "am", "gear")),
              selected = c("cyl", "gear"),
              multiple = TRUE,
              ordered = TRUE,
              fixed = FALSE
            )
          ),
          y = data_extract_spec(
            dataname = "mtcars",
            select = select_spec(
              label = "Select variable:",
              choices = variable_choices("mtcars", c("cyl", "vs", "am", "gear")),
              selected = "vs",
              multiple = FALSE,
              fixed = FALSE
            )
          ),
          basic_table_args = basic_table_args(
            subtitles = "Table generated by Crosstable Module"
          )
        )
      )
    })

    module_objs <- mapply(FUN = do.call, what = module_funs, args = module_args, SIMPLIFY = FALSE)
    do.call("modules", module_objs)
  })

  # track display state
  areweinspecting <- reactiveVal(FALSE)


  # switch between app configuration and inspection
  observeEvent(input[["master_button"]], {
    areweinspecting(!areweinspecting())
    if (!areweinspecting()) {
      teal_app_counter(teal_app_counter() + 1L)
      removeUI("#teal_app_container")
      ### EVENT HANDLERS ARE REMOVED HERE ###
      runjs('
        $(document).off("shiny:connected.tealWidgets");
        $(window).off("resize.tealWidgets");
      ')
      insertUI(
        "#teal_app_inspection",
        "afterBegin",
        teal_app_ui(teal_app_counter())
      )
    }
    if (areweinspecting()) {
      srv_teal_with_splash(
        id = teal_module_id(teal_app_counter()),
        data = teal_app_data(),
        modules = teal_app_modules()
      )
    }
    toggleElement("teal_app_container", condition = isTRUE(areweinspecting()))
    toggleElement("teal_app_controls", condition = isFALSE(areweinspecting()))
    updateActionButton(inputId = "master_button", label = if (areweinspecting()) "configure app" else "generate app")
  })
}

shinyApp(ui, server, options = list("launch.browser" = TRUE))

[github-actions]

CLA Assistant Lite bot ✅ All contributors have signed the CLA

[chlebowa]

I have read the CLA Document and I hereby sign the CLA

[donyunardi]

Is there any connection between this and #245?
tagging @Polkas

[Polkas]

No, their task looks to be connected with teal.builder needs and is a feature request. I can not see it influence the #245 problem.

#245 is an apparent bug in the teal.widgets and is connected only with plot_with_settings and possibly table_with_settings additional modal functionality.

@donyunardi I recommend not accepting any merge to the main without proper testing on Bootstrap 5. Please be careful.

[chlebowa]

I can not see it influence the #245 problem.

I concur.

I recommend not accepting any merge to the main without proper testing on Bootstrap 5. Please be careful.

I checked under bs 3 and 5 (and 4 just now for good measure) and it seems safe to me. No JS errors, either.

[chlebowa]

Superseded by insightsengineering/teal#1261