Multiple Plotly Outputs

[lphmn]

Hello,

A process that I can't seem to figure out is having multiple plotly plots appear at one time. I apologize if this has been addressed previously, but the only discussion I was able to find did not have a workaround solution. It can be found here

I am experiencing this exact issue. I have working examples of plotly plots being executed via a function or a module. Similar to the previous link, if I change a reactive input, all the plotly plots will appear and work correctly. It seems to be the initial load. Here is a reproducible example (Move the slider and the second plot will appear)

I did try setting a reactive input to be delayed via shinyjs, but in the shinyLive environment the delay did not work while the delay did work in my local shiny environment. Thank you for any suggestions/insights.

[gadenbuie]

I've also run into this. The example in the linked StackOverflow question reproduces currently on shinylive.

• In the sidebar choose one variable, this should add two card, each with one plotly plot.
• The first plotly plot fails to render; thereafter the rest of the plots render as expected.

In the console I see errors like

[Error] Unhandled Promise Rejection: ReferenceError: Can't find variable: Plotly
	renderValue (plotly.js:162)
	(anonymous function) (htmlwidgets.js:539)

[Error] TypeError: undefined is not an object (evaluating 'l._guiEditing')
	W (plotly-latest.min.js:41:550306)
	U (plotly-latest.min.js:41:548702)
	resize (plotly.js:14)
	(anonymous function) (htmlwidgets.js:550)
	(anonymous function) (shiny.min.js:2:327837)
	(anonymous function) (shiny.min.js:2:78073)
	(anonymous function) (components.min.js:2:4942)
	forEach
	(anonymous function) (components.min.js:2:4753)

@georgestagg Do you have any idea about the cause?

Example app

library(shiny)
library(bslib)
library(plotly)

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) {
      layout_columns(
        col_widths = c(8, 4),
        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))
          )
        ),
        bslib::card(
          card_header(
            "Histogram"
          ),
          plotlyOutput(paste0("histogram_", 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'
        )
      })
      output[[paste0("histogram_", parameter)]] <- renderPlotly({
        plot_ly(
          data,
          x = ~data[[parameter]],
          type = 'histogram'
        )
      })
    })
  })
  
  observe({
    req(input$select)
    lapply(input$select, function(parameter) {
      storage$color[[parameter]] <- input[[paste0("select_color_", parameter)]]
    })
  })
  
}

shinyApp(ui = ui, server = server)

[georgestagg]

I think this is likely due to a change made to webR's Wasm version of the htmlwidgets package: r-wasm/htmlwidgets@892798f

This is unfortunately a pretty strong requirement for widgets to work under Shinylive because synchronously loading XHR content through a JS Service Worker has a long-standing bug under Chromium (since 2016, possibly earlier).

I know of a workaround, but it's a pretty nasty hack: explicitly adding tags$script(src = "https://cdn.plot.ly/plotly-2.11.1.min.js") to the UI so that the dependency is loaded from external CDN (i.e. not through the Service Worker), before the plotly plots are first rendered. There might also be better ways to achieve the same thing.

Example App 1

Example App 2

[Luke-Symes-Tsy]

Just linking to related (duplicate?) tickets: r-wasm/webr#330 posit-dev/shinylive#116

[hazelvaq]

I had a similar issue with running multiple renderDataTable and adding tags$script(src = "https://cdn.datatables.net/1.11.3/js/jquery.dataTables.min.js") to the UI also fixed it!

[hazelvaq]

Hello!

Another issue I noticed with the reactivity is when working with prettySwitch toggling off does not show the correct reaction. Here is the same reproducible example from this thread with the added prettySwitch to toggle on and off the charts. You can turn the visibility of the charts on and once you turn it off the chart is still visible. The charts don't get updated with the sliderInput so it is technically turning "off" that reaction but is not reflected in the UI output.

[lphmn]

Hey Hazelvaq,

I am really new to a lot of this but I have found that req does goofy things for me. Try changing the req to an if statement. # Bar plot 1 ----
output$barPlot1 <- plotly::renderPlotly({
if(input$display){
bins <- seq(min(data$x), max(data$x), length.out = input$bins + 1)
hist_data <- hist(data$x, breaks = bins, plot = FALSE)
plot_ly(x = hist_data$mids, y = hist_data$counts, type = 'bar')
}
})

Bar plot 2 ----

output$barPlot2 <- plotly::renderPlotly({
if(input$display)
{
bins <- seq(min(data$x), max(data$x), length.out = input$bins + 1)
hist_data <- hist(data$x, breaks = bins, plot = FALSE)
plot_ly(x = hist_data$mids, y = hist_data$counts, type = 'bar')
}
})
Edit* I am not good enough yet to know why req doesn't work well, so hopefully someone can explain the reason why an if statement works better than a req statement.

[hazelvaq]

Thank you! I need to try it out on my app now!

[georgestagg]

Note that the issue with req() has been fixed in #128 and is should be included as part of the next release of Shinylive assets.