Plotly plot not rendered when rendering two plotly plots at once using shinylive for R

51 Views Asked by At

I've written a relatively simple demo Shiny app in R using bslib and plotly.

In this app, when selecting an entry from the selectizeInput, two plotly plots are rendered, namely a scatter plot on the left and a histogram plot on the right. Running this app on RStudio on my local machine, everything works fine.

When using shinylive::export() to export this app as a shinylive app and hosting it on a webserver (see here: https://valentin-kamm.github.io/shinylivePlotlyIssueDemo/), this does not work. Only the second plotly plot (histogram) is rendered, while the first one fails with the following error in the browser console:

Uncaught (in promise) ReferenceError: Plotly is not defined
    at Object.renderValue (plotly.js:162:18)
    at htmlwidgets.js:539:22

However, when performing some modifications that causes the first plot to re-render, it suddenly works. The error only occurs on the first plot that should be rendered.

I'm aware that shinylive is still experimental, so it could just be a bug. But maybe, there is a workaround here?

# 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) {
      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)
0

There are 0 best solutions below