快速切换选项卡时,“闪亮的绘图”绘图卡住了

时间:2018-10-24 15:55:13

标签: r shiny plotly

我正在尝试找到一种方法,避免在加载绘图之前在Shiny中切换选项卡时在不重新加载整个绘图的情况下避免调整大小的问题。下面给出了一个重现此问题的最小示例,方法是从正态分布幅度时间中抽取样本,然后再绘制直方图作为计算密集型图的占位符。

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)

卡住的图看起来像链接的图像:  Stuck Plot

如果以任何方式调整其大小(例如,通过调整其所在窗口的大小),该图将正确显示,并且在固定图宽时不会发生此问题。

提前致意和感谢。

1 个答案:

答案 0 :(得分:0)

在我看来,这似乎是一个Plotly方面的错误。如果您不指定起始宽度,则绘图将为100px宽。将div的宽度更改为100%并不会真正起作用。

您可以包含一些Javascript来在每次单击“制表符”时调整图的大小,或者您可以在闪亮状态下停用所有“制表符”按钮。

使用resize方法,每次您按下Tab键时,图将被重绘,并且在更改窗口大小之后,它们将再次正常调整大小。我还尝试使用Plotly的redrawrelayout方法,但未成功。

因此,我希望第二个选项在应用程序忙时禁用选项卡,但这并不能真正回答您的问题,因此我注释掉了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)