Shiny падает при нажатии кнопки Run - но только при запуске в определенной вкладке - PullRequest
Новая
       52

Shiny падает при нажатии кнопки Run - но только при запуске в определенной вкладке

0 голосов
/ 02 мая 2018

У меня действительно странная проблема с моим приложением. Пользовательский интерфейс состоит из 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) функций, и довольно сложно определить, что является причиной проблемы. Ни в одном из них не очевидно, что в качестве второго аргумента передается что-либо, кроме списка.

Мой сервер и пользовательский интерфейс находятся ниже. Я пропустил большую часть расчетов и извиняюсь, что не могу полностью воспроизвести проблему здесь. Просто надеясь, что в структуре приложения есть очевидная ошибка, которую кто-то может заметить. Любые предложения приветствуются

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 голосов
/ 02 мая 2018

Когда объекты не видны на странице, они по умолчанию приостанавливаются (не выполняются). Таким образом, вы получите сообщение об ошибке при попытке использовать выходные данные, созданные на любой из вкладок, которые вы еще не открыли. Вы можете обойти это с помощью outputOptions см. Ссылку здесь . Обратите внимание на следующее:

suspendWhenHidden. Когда TRUE (по умолчанию), выходной объект будет приостановлен (не выполнен), когда он будет скрыт на веб-странице. Когда FALSE, выходной объект не будет приостановлен, когда скрыт, и если он уже был скрыт и приостановлен, то он немедленно возобновится.

В основном 4 вкладки, которых нет на экране, приостановлены и не будут отображаться, пока вы не нажмете на них. Это объясняет, почему, когда вы нажимаете на них и возвращаетесь, вы не видите ту же ошибку. Добавьте строку, аналогичную этой, в нижней части скрипта вашего сервера для каждой вкладки, которую вы хотите отобразить: 

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