R闪亮for循环中的进度条答案

【问题标题】：Progress bar in R shiny for loopR闪亮for循环中的进度条
【发布时间】：2018-11-21 16:01:06
【问题描述】：

我无法让进度条与闪亮的 selectInput 函数一起工作。它给出了用户选择加载到页面的数据的进度，而不是应用程序执行它应该对数据执行的循环。这是我到目前为止所拥有的：

ui <- fluidPage(  
  titlePanel("Upload Files"),  
  sidebarLayout(  
    sidebarPanel(  
      fileInput("upload", "Select Files",  
                multiple = TRUE,  
                accept = c("text/csv",  
                           "text/comma-separated-values,text/plain"))  
    ),  
    mainPanel(  
      tableOutput("table")  
    )  
  )  
)  

server <- function(input, output) {  
  observeEvent(input$upload, {for (i in 1:length(input$upload$datapath)) {  *code to execute*  
}})  
output$table <- renderTable(  
print(input$upload$name))  
}  
shinyApp(ui,server)

【问题讨论】：

标签： r shiny

【解决方案1】：

我不确定您是否可以调整 fileInput 的加载栏以响应循环，但这里有一个带有新进度条的替代方案。

ui <- fluidPage( 

  # With this tag you can change the position and the size of the progress bar
  # Without it, the bar will be at the bottom right corner of the screen
  tags$head(tags$style(".shiny-notification {position: fixed; 
                                             opacity: 1 ;
                       top: 35% ;
                       left: 40% ;
                       height: 50px;
                       width: 300px}")),

  titlePanel("Upload Files"),  
  sidebarLayout(  
    sidebarPanel(  
      fileInput("upload", "Select Files",  
                multiple = TRUE,  
                accept = c("text/csv",  
                           "text/comma-separated-values,text/plain"))  
    ),  
    mainPanel(  
      tableOutput("table")  
    )  
  )  
)  

server <- function(input, output) { 

  observeEvent(input$upload, {

    # wrap the loop execution in withProgress
    withProgress(
      message='Please wait',
      detail='Doing important stuff...',
      value=0, {

        for (i in 1:5) {  # changed the loop for demonstration purposes

          Sys.sleep(0.8)  # pretending to execute code
          incProgress(amount=1/5)
        }
      })
  })

  output$table <- renderTable(print(input$upload$name))  
}  

shinyApp(ui,server)

【讨论】：