UI glitch in R Shiny app when dynamically adding plotly plots and using reactive values

Question

I've written a relatively simple demo Shiny application in R using bslib, where the user can choose one or more variables of the mtcars dataset. For each variable, a plotly plot will be generated.

Furthermore, the user can choose the color of the markers of each dynamically generated plot using a selectInput in the sidebar.

I've faced the problem that the colors chosen for the plots will obviously be reset to the default value every time a plot is added or removed. This is why I've implemented a simple storage using reactiveValues.

However, this leads to weird UI behavior that I can neither explain nor fix, which is why I'm asking for help.

For example, carry out the following steps:

1. Generate any number of plots with any variables of your choice
2. Change the marker color of the first plot -> It works
3. Put the first card in full screen
4. Change the marker color of this plot again in full screen mode

This will "crash" the full screen view, but not only that: The controls for putting the card into full screen view will be gone.

I'm assuming that I'm not using the reactiveValues correctly, but I cannot figure out what I'm doing wrong. Any help would be much appreciated.

# packages
library(shiny)
library(bslib)
library(plotly)

# clean environment
rm(list = ls())

data = data.frame(head(mtcars, 100))
choices = colnames(data)
choices = choices[-c(1)]

ui <- bslib::page_navbar(
  bslib::nav_panel(
    title = "Tab 1",
    fillable = FALSE,
    bslib::layout_sidebar(
      sidebar = bslib::sidebar(
        "Sidebar",
        shiny::selectizeInput(
          "select",
          "Choose",
          multiple = TRUE,
          selected = character(0),
          choices = choices
        )
      ),
      shiny::uiOutput("content")
    )
  )
)

server <- function(input, output) {
  
  storage <- reactiveValues(color = list())
  
  output$content <- shiny::renderUI({
    req(input$select)
    output_list <- lapply(input$select, function(parameter) {
      bslib::card(
        height = "400",
        full_screen = TRUE,
        bslib::card_header(
          shiny::textOutput(paste0("title_", parameter))
        ),
        bslib::layout_sidebar(
          sidebar = bslib::sidebar(
            shiny::selectInput(
              paste0("select_color_", parameter),
              "Marker color",
              choices = choices,
              selected = ifelse(parameter %in% names(storage$color), storage$color[[parameter]], choices[1])
            )
          ),
          plotlyOutput(paste0("plot_", parameter))
        )
      )
    })
    do.call(tagList, output_list)
  })
  
  observe({
    req(input$select)
    lapply(input$select, function(parameter) {
      output[[paste0("title_", parameter)]] <- shiny::renderText({
        paste0("Plot ", parameter)
      })
      output[[paste0("plot_", parameter)]] <- renderPlotly({
        plot_ly(
          data,
          x = ~mpg,
          y = ~data[[parameter]],
          color = ~data[[input[[paste0("select_color_", parameter)]]]],
          type = 'scatter',
          mode = 'markers'
        )
      })
    })
  })
  
  observe({
    req(input$select)
    lapply(input$select, function(parameter) {
      storage$color[[parameter]] <- input[[paste0("select_color_", parameter)]]
    })
  })
  
}

shinyApp(ui = ui, server = server)

Answer 1

That was hard...

Indeed, when you choose a coloring variable, the `uiOutput("content") is re-rendered. Then, this causes the full-screen mode to exit, and since it has not been exited by clicking the 'Close' button, the 'Expand' stuff at the bottom-right of the card does not reappear.

With the code below, I avoid the re-rendering of uiOutput("content") by isolating storage$color. This seems ok.

  output$content <- shiny::renderUI({
    req(input$select)
    output_list <- lapply(input$select, function(parameter) {
      colors <- isolate(storage$color) # isolate
      bslib::card(
        wrapper = function(...) card_body(..., height = 300, max_height = 400),
        full_screen = TRUE,
        bslib::card_header(
          shiny::textOutput(paste0("title_", parameter))
        ),
        bslib::layout_sidebar(
          sidebar = bslib::sidebar(
            shiny::selectInput(
              paste0("select_color_", parameter),
              "Marker color",
              choices = choices, # use 'colors' below:
              selected = ifelse(parameter %in% names(colors), colors[[parameter]], choices[1])
            )
          ),
          plotlyOutput(paste0("plot_", parameter))
        )
      )
    })
    do.call(tagList, output_list)
  })