plotly.R icon indicating copy to clipboard operation
plotly.R copied to clipboard

partial_bundle causes a Shiny app to fail when used in a module with only plotly outputs

Open wholmes105 opened this issue 3 years ago • 0 comments


The app below fails to render any of its outputs when I try to run it; the error message in my web browser's console says Uncaught ReferenceError: Plotly is not defined. I believe this is due to partial_bundle() being used when a plotly object is first rendered in a shiny module with renderPlotly().

When I was creating this example, I noticed that this bug did not appear if either of the following conditions were met:

  • The plotly object that is rendered inside the shiny module for the first time didn't use partial_bundle(), for example, if the initial render of the plot didn't use partial_bundle() due to conditional logic
  • The app has a non-plotly output visible, inside or outside the module, when the app is first rendered
library(plotly) # 4.10.0
library(shiny) # 1.7.1

# Create dummy data
dummy_data = data.frame(
  x = Sys.Date() + 1:nrow(iris),
  y = iris$Sepal.Length,
  Species = iris$Species
)

testUI <- function(id, scatter_name, bar_name) {
  # Define the namespace for this module
  ns = NS(id)
  
  # Return the UI elements for this module
  tagList(
    plotlyOutput(ns(scatter_name)),
    plotlyOutput(ns(bar_name))
  )
}

testServer <- function(id, scatter_name, bar_name) {
  moduleServer(
    id,
    function(input, output, session) {
      output[[scatter_name]] = renderPlotly({
        # req(selected_bars()) # This causes the entire app to fail to load if it is included
        
        if(length(selected_bars()) == 0) {
          iris %>% 
            plot_ly(
              type = 'scatter',
              mode = 'markers',
              x = ~Sepal.Length,
              y = ~Sepal.Width
            ) %>%
            # Causes an error
            partial_bundle(type = 'cartesian')
        } else {
          iris %>% 
            filter(Species %in% selected_bars()) %>% 
            plot_ly(
              type = 'scatter',
              mode = 'markers',
              x = ~Sepal.Length,
              y = ~Sepal.Width,
              color = ~Species
            ) %>% 
            layout(showlegend = TRUE) %>% 
            # Does not cause an error
            partial_bundle(type = 'cartesian')
        }
        
      })
      
      output[[bar_name]] = renderPlotly({
        dummy_data %>%
          group_by(Species) %>%
          summarise(
            bar_val = mean(y)
          ) %>% 
          arrange(Species) %>% # This is required to mitigate issue #1657
          plot_ly(
            type = 'bar',
            source = bar_name,
            x = ~factor(Species, levels = Species[order(-bar_val)]),
            y = ~bar_val,
            opacity = ifelse(
              .$Species %in% selected_bars() | length(selected_bars()) == 0,
              1,
              .2
            ),
            split = ~Species,
            showlegend = FALSE
          )
      })
      
      # Track what bar(s) the user has selected via click
      selected_bars = reactiveVal(value = character(), label = 'selected_bars')
      
      mod_issue_bar_click = reactive({
        event_data(event = 'plotly_click', source = bar_name, priority = 'event')$x
      })
      
      observeEvent(mod_issue_bar_click(), {
        if(! mod_issue_bar_click() %in% selected_bars()) {
          selected_bars(
            c(
              selected_bars(),
              mod_issue_bar_click()
            )
          )
        } else {
          selected_bars(
            selected_bars()[selected_bars() != mod_issue_bar_click()]
          )
        }
      })
    }
  )
}

shinyApp(
  ui = fluidPage(
    testUI(
      'test', 
      scatter_name = 'test_line', 
      bar_name = 'test_bar'
    ),
    hr(), # Visually separates outputs from the module and those not from the module
    plotlyOutput('dummy_plot')
    # ,
    # plotOutput('dummy_plot2')
  ),
  server = function(input, output, session) {
    testServer(
      'test', 
      scatter_name = 'test_line', 
      bar_name = 'test_bar'
    )
    
    output$dummy_plot = renderPlotly({
      iris %>% 
        plot_ly(
          type = 'scatter',
          mode = 'markers',
          x = ~Sepal.Length,
          y = ~Sepal.Width
        )
    })
    
    # output$dummy_plot2 = renderPlot({
    #   plot(
    #     x = iris$Sepal.Length,
    #     y = iris$Sepal.Width,
    #     type = 'b'
    #   )
    # })
  }
)

wholmes105 avatar Apr 05 '22 16:04 wholmes105