单击运行按钮时闪亮崩溃 - 但仅当在某个选项卡中启动时

Question

我的应用程序遇到了一个非常奇怪的问题。 UI 由 5 个选项卡组成。前两个包含 RHandsontables，可以由用户编辑并用作计算中的输入。最后 3 个包含单击 "Run" 按钮后生成的 DataTable 输出。

如果我打开应用程序并单击 "Run" 而没有单击任何选项卡（即将其保留在默认选项卡上），应用程序会崩溃并显示以下消息：

Listening on http://127.0.0.1:5554
Warning: Error in do.call: second argument must be a list
Stack trace (innermost first):
    67: do.call
    66: hot_to_r
    65: observeEventHandler [path/to/serverfile]

但是，如果我打开应用程序，单击其他选项卡之一，然后导航回第一个选项卡并单击 "Run"，应用程序运行没有任何问题。这没有意义，因为通过短暂单击不同的选项卡然后返回原始选项卡，输入等方面实际上没有任何改变。

服务器文件中有几个 do.call("rbind", list) 函数，它的 quite 很难查明导致问题的函数。在其中的 none 中很明显，除了列表之外的任何内容都作为第二个参数传递。

我的服务器和ui文件在下面。我省略了大部分计算，很抱歉我无法在此处完全重现该问题。只是希望有人可能会注意到应用程序的结构中存在明显的错误。欢迎任何建议

Server.R

library(tidyverse)
library(shiny)
library(DT)
library(rhandsontable)

# Server file for World Cup Outright App
shinyServer(function(input,output,session){
  values <- reactiveValues()


  output$Results <- renderRHandsontable({
    if (input$currentStage=="Group Stage"){
      rhandsontable(read.csv("path/to/file", colClasses = c('character','character','numeric','numeric')))
    }
    else if (input$currentStage=="Last 16"){
      rhandsontable(read.csv("path/to/file", colClasses = c('character','character','numeric','numeric')))
    }
    else{ 
      rhandsontable(read.csv("path/to/file", colClasses = c('character','character','numeric','numeric')))
    }
  })


  observeEvent(input$runButton,{
    values$results_table <- hot_to_r(input$Results)
  })



  output$Ratings <- renderRHandsontable({
    rhandsontable(read.csv("path/to/file", colClasses=c('character','numeric','numeric','numeric','numeric')))

  })


  observeEvent(input$runButton,{
    values$ratings_table <- hot_to_r(input$Ratings)
  })


  price_markets <- eventReactive(input$runButton, {
    withProgress(message="Loading...",{

      t1 <- Sys.time()

      # Choose the number of simulations required
      sims <- as.numeric(input$simsInput)
      if(is.null(sims)){return()}

      Games <- read.csv("path/to/file",header = TRUE,colClasses = c('character','character','numeric','numeric'))
      ratingvratingfile <- read.csv("path/to/file", colClasses=c('numeric','numeric'),header=F,col.names=c('diff','prob1','prob2'))
      Last16Games <- read.csv("path/to/file",header = TRUE,colClasses = c('character','character','character','numeric','numeric'))
      QuarterFinalGames <- read.csv("path/to/file",header = TRUE,colClasses = c('character','character','character','numeric','numeric'))
      groupLookup <- read.csv("path/to/file", colClasses = c('character','character'))
      continentLookup <- read.csv("path/to/file", colClasses = c('character','character'))

      liveresults <- values$results_table
      liveLast16results <- values$results_table
      liveQFresults <- values$results_table
      ratingsfile <- values$ratings_table


      CurrentStage <- input$currentStage


      if(CurrentStage=="Group Stage"){

        # CALCULATIONS
      }



      if (CurrentStage=="Last 16"){

        # CALCULATIONS
     }

      if(CurrentStage=="Quarter Finals"){

        # CALCULATIONS

      }

      t2 <- as.numeric(difftime(Sys.time(), t1),units="mins")
      t2 <- round(t2,2)
      t2 <- paste0(as.character(t2)," minutes to run sims")


      # Put outputs in a list to be accessed by renderDataTable functions later
      list(groupApositions,groupAforecasts,groupAtricasts,
           groupBpositions,groupBforecasts,groupBtricasts,
           groupCpositions,groupCforecasts,groupCtricasts,
           groupDpositions,groupDforecasts,groupDtricasts,
           groupEpositions,groupEforecasts,groupEtricasts,
           groupFpositions,groupFforecasts,groupFtricasts,
           groupGpositions,groupGforecasts,groupGtricasts,
           groupHpositions,groupHforecasts,groupHtricasts,
           to_reach,stage_of_elim,name_the_finalists,t2,
           winners1,winners2)
    })
  })



  output$groupStagePositionTable <- DT::renderDataTable(DT::datatable({
    if(input$groupMarkets=="Group A"){
      table <- price_markets()[[1]]
    }
    if(input$groupMarkets=="Group B"){
      table <- price_markets()[[4]]
    }
    if(input$groupMarkets=="Group C"){
      table <- price_markets()[[7]]
    }
    if(input$groupMarkets=="Group D"){
      table <- price_markets()[[10]]
    }
    if(input$groupMarkets=="Group E"){
      table <- price_markets()[[13]]
    }
    if(input$groupMarkets=="Group F"){
      table <- price_markets()[[16]]
    }
    if(input$groupMarkets=="Group G"){
      table <- price_markets()[[19]]
    }
    if(input$groupMarkets=="Group H"){
      table <- price_markets()[[22]]
    }
    return(table)}),rownames=FALSE,options=list(pageLength=100,info=FALSE,paging=FALSE,searching=FALSE))


  output$groupStageForecastTable <- DT::renderDataTable(DT::datatable({
    if(input$groupMarkets=="Group A"){
      table <- price_markets()[[2]]
    }
    if(input$groupMarkets=="Group B"){
      table <- price_markets()[[5]]
    }
    if(input$groupMarkets=="Group C"){
      table <- price_markets()[[8]]
    }
    if(input$groupMarkets=="Group D"){
      table <- price_markets()[[11]]
    }
    if(input$groupMarkets=="Group E"){
      table <- price_markets()[[14]]
    }
    if(input$groupMarkets=="Group F"){
      table <- price_markets()[[17]]
    }
    if(input$groupMarkets=="Group G"){
      table <- price_markets()[[20]]
    }
    if(input$groupMarkets=="Group H"){
      table <- price_markets()[[23]]
    }
    return(table)}),rownames=FALSE,options=list(pageLength=100,info=FALSE,paging=FALSE,searching=FALSE))



  output$groupStageTricastTable <- DT::renderDataTable(DT::datatable({
    if(input$groupMarkets=="Group A"){
      table <- price_markets()[[3]]
    }
    if(input$groupMarkets=="Group B"){
      table <- price_markets()[[6]]
    }
    if(input$groupMarkets=="Group C"){
      table <- price_markets()[[9]]
    }
    if(input$groupMarkets=="Group D"){
      table <- price_markets()[[12]]
    }
    if(input$groupMarkets=="Group E"){
      table <- price_markets()[[15]]
    }
    if(input$groupMarkets=="Group F"){
      table <- price_markets()[[18]]
    }
    if(input$groupMarkets=="Group G"){
      table <- price_markets()[[21]]
    }
    if(input$groupMarkets=="Group H"){
      table <- price_markets()[[24]]
    }
    return(table)}),rownames=FALSE,options=list(pageLength=50,info=FALSE,paging=FALSE,searching=FALSE))


  output$outrightMarketTable <- DT::renderDataTable(datatable({
    if(input$outrightMarkets=="To Reach"){
      table1 <- price_markets()[[25]]
    }
    if(input$outrightMarkets=="Stage of Elimination"){
      table1 <- price_markets()[[26]]
    }
    if(input$outrightMarkets=="Name the Finalists"){
      table1 <- price_markets()[[27]]
    }
    return(table1)}),rownames=FALSE,options=list(paging=FALSE))


  output$winningGroupTable <- DT::renderDataTable(datatable({
    table <- price_markets()[[29]]
    return(table)
  }),rownames=FALSE,options=list(searching=FALSE,info=FALSE,paging=FALSE))


  output$winningContinent <- DT::renderDataTable(datatable({
    table <- price_markets()[[30]]
    return(table)
  }),rownames=FALSE,options=list(searching=FALSE,info=FALSE,paging=FALSE))



  output$timeElapsed <- renderText({price_markets()[[28]]})


})

ui.R

library(tidyverse)
library(shiny)
library(DT)
library(rhandsontable)

# User Interface for World Cup Outright App
shinyUI(fluidPage(

  titlePanel("World Cup Outright Simulator"),


  sidebarLayout(



    sidebarPanel(
      selectInput('currentStage','Choose current stage',c("Group Stage","Last 16","Quarter Finals")),
      textInput("simsInput",label="Number of Simulations",value = 10000),
      actionButton("runButton","Run"),
      h2(textOutput("timeElapsed"))
    ),

    mainPanel(
      tabsetPanel(
        tabPanel("Results",
                 rHandsontableOutput("Results")),
        tabPanel("Ratings",
                 rHandsontableOutput("Ratings")),
        tabPanel("Group Stage",
                 selectInput('groupMarkets','Choose Group',c("Group A", "Group B","Group C","Group D","Group E","Group F","Group G","Group H")),
                 h3("Group Positions"),
                 DT::dataTableOutput("groupStagePositionTable"),
                 h3("Group Forecasts"),
                 DT::dataTableOutput("groupStageForecastTable"),
                 h3("Group Tricasts"),
                 DT::dataTableOutput("groupStageTricastTable")

                 ),
        tabPanel("Outright",
                 selectInput('outrightMarkets','Choose Market',c("To Reach","Stage of Elimination","Name the Finalists")),
                 DT::dataTableOutput("outrightMarketTable")),

        tabPanel("Special",
                 h3("Winning Group"),
                 DT::dataTableOutput("winningGroupTable"),
                 h3("Winning Continent"),
                 DT::dataTableOutput("winningContinent"))

        )
      )
    )
  )
)

Answer 1

当对象在页面上不可见时，它们在 shiny 中默认被挂起（不执行）。因此，当您尝试使用在您尚未打开的任何选项卡上生成的输出时，您将收到错误消息。您可以使用 outputOptions 解决这个问题，请参阅参考资料 here。注意以下几点：

suspendWhenHidden. When TRUE (the default), the output object will be suspended (not execute) when it is hidden on the web page. When FALSE, the output object will not suspend when hidden, and if it was already hidden and suspended, then it will resume immediately.

基本上不在屏幕上的4个标签是悬浮的，只有点击它们才会呈现。这解释了为什么当您单击它们并返回时您看不到相同的错误。在您的服务器脚本底部为您需要呈现的每个选项卡添加一行类似于此的行：

outputOptions(output, "Ratings", suspendWhenHidden = FALSE)

单击运行按钮时闪亮崩溃 - 但仅当在某个选项卡中启动时

Shiny crashes when Run button is clicked - but only when starting in a certain tab

r

shiny

dt

rhandsontable

单击 运行 按钮时闪亮崩溃 - 但仅当在某个选项卡中启动时

Shiny crashes when Run button is clicked - but only when starting in a certain tab

r

shiny

dt

rhandsontable

单击运行按钮时闪亮崩溃 - 但仅当在某个选项卡中启动时