Shiny Plotly Plot stuck when switching tabs quickly

Viewed 519

I am trying to find a way to avoid resizing problems without reloading the complete plot when switching tabs in Shiny before the plot is loaded. A minimal example to recreate the problem is given below by drawing samples from a normal distribution magnitude times and plotting a histogram afterwards as a placeholder for a computation-intensive plot.

time_waste<- function(magnitude) {
  y<-0
  for(i in 1:magnitude) {
    y<- y + rnorm(1,0,1)
  }
  return(abs(y))
}

ui <- fluidPage(sidebarLayout(
    sidebarPanel(width = 3,
                              fluidRow(
                                column(
                                  4,
                                  numericInput(
                                    inputId = "magnitude",
                                    label = "magnitude",
                                    value = 1000000
                                      )))),
    mainPanel(width = 8,
              tabsetPanel(id = "tabset",
                          tabPanel("Plot1", plotlyOutput("p1", height = "700px")),
                          tabPanel("Plot2", plotlyOutput("p2", height = "700px"))))
  )
  )

server<- function(input, output, session) {

  y<- reactive({
    rep(time_waste(time_waste(input$magnitude)),3)
  })

  output$p1 <- renderPlotly({

  p<- plot_ly(
    x = c("giraffes", "orangutans", "monkeys"),
    y = y(),
    name = "SF Zoo",
    type = "bar"
  )
  })

  output$p2<-  renderPlotly({

    p<- plot_ly(
      x = c("giraffes", "orangutans", "monkeys"),
      y = y(),
      name = "SF Zoo",
      type = "bar"
    )

  return(p)
  })

}

app <- shinyApp(ui, server)
runApp(app)

The stuck plot then looks like the image linked: Stuck Plot

The plot displays correctly if it gets resized in any way (e.g. by resizing the window it is in) and the problem does not occur with fixed plotwidth.

Kind regards and thanks in advance.

1 Answers

This looks like a bug on Plotly side to me. If you dont assign a starting width, the plot will be 100px wide. Changing the width of the div to 100% doesnt really do much.

You could include some Javascript to resize the plot every time the Tab is clicked, or you could deactivate all Tab buttons as long as shiny is busy.

With the resize method, the plots will be redrawn every time you hit the Tab, and after changing the window size, they resize normally again. I also tried to use the redraw, relayout methods of Plotly without success.

So, I would prefer the 2nd option, to disable the Tabs while the app is busy, but that doesnt really answer your question, so i commented out the JavaScript.

time_waste<- function(magnitude) {
  y<-0
  for(i in 1:magnitude) {
    y<- y + rnorm(1,0,1)
  }
  return(abs(y))
}


## Resize plot p1 at every Tab click. 
js <- HTML("
$(document).on('shiny:value', function() { 
$('#tabset li a').on('click',function() {
  Plotly.Plots.resize('p1');
});
});
"
)


## Deactivate all Buttons as long as shiny is busy
# js <- HTML('
# $(document).on("shiny:busy", function() {
#  var inputs = document.getElementsByTagName("a");
#  console.log(inputs);
#  for (var i = 0; i < inputs.length; i++) {
#  inputs[i].disabled = true;
#  }
# });
# 
# $(document).on("shiny:idle", function() {
#  var inputs = document.getElementsByTagName("a");
#  console.log(inputs);
#  for (var i = 0; i < inputs.length; i++) {
#  inputs[i].disabled = false;
#  }
# });'
# )


ui <- fluidPage(
  ## Include JavaScript to the HTML
  tags$head(tags$script(js)),
  sidebarLayout(
  sidebarPanel(width = 3,
               fluidRow(
                 column(4,
                   numericInput(
                     inputId = "magnitude",
                     label = "magnitude",
                     value = 1000000
                   )))),
  mainPanel(width = 8,
            tabsetPanel(id = "tabset",
                        tabPanel("Plot1", plotlyOutput("p1", height = "700px")),
                        tabPanel("Plot2", plotlyOutput("p2", height = "700px"))))
  )
)

server<- function(input, output, session) {
  y <- reactive({
    rep(time_waste(time_waste(input$magnitude)),3)
  })

  output$p1 <- renderPlotly({
    plot_ly(x = c("giraffes", "orangutans", "monkeys"),
      y = y(),name = "SF Zoo",type = "bar")
  })

  output$p2<-  renderPlotly({
    plot_ly(x = c("giraffes", "orangutans", "monkeys"),
      y = y(), name = "SF Zoo",type = "bar")
  })
}

shinyApp(ui, server)
Related