单击“运行”按钮时闪亮崩溃 - 但仅在以特定选项卡

时间:2018-05-02 10:36:14

标签: r shiny dt rhandsontable

我的应用程序出现了一个非常奇怪的问题。 UI由5个选项卡组成。前两个包含RHandsontables,可以由用户编辑并用作计算中的输入。最后3个包含DataTable输出,这些输出是在单击“运行”按钮后生成的。

如果我打开应用程序并单击“运行”而不单击任何选项卡(即将其保留在默认选项卡上),应用程序将崩溃并显示以下消息:

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]

但是,如果我打开应用程序,单击其他选项卡之一,然后导航回第一个选项卡并单击“运行”,应用程序运行时没有任何问题。这没有意义,因为通过短暂地点击不同的标签然后回到原来的标签,没有任何关于输入等实际改变。

服务器文件中有几个do.call("rbind", list)函数,很难找到造成问题的函数。在其中没有一个显然除了列表之外的任何东西都被作为第二个参数传递。

我的服务器和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"))

        )
      )
    )
  )
)

1 个答案:

答案 0 :(得分:1)

当页面上的对象不可见时,默认情况下它们会被暂停(不执行)。因此,当您尝试使用尚未打开的任何选项卡上生成的输出时,您将收到错误消息。您可以使用outputOptions来解决此问题,请参阅参考here。请注意以下事项:

  

suspendWhenHidden。当为TRUE(默认值)时,输出对象在网页上隐藏时将被挂起(不执行)。如果为FALSE,则输出对象在隐藏时不会挂起,如果已隐藏并暂停,则会立即恢复。

基本上,屏幕上没有的4个标签会被暂停,直到您点击它们才会呈现。这解释了为什么当您点击它们并返回时,您不会看到相同的错误。对于需要呈现的每个选项卡,在服务器脚本底部添加与此类似的行:

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