闪亮的进度条过早出现

Question

我正在尝试使用进度条（通过命令 'withProgress'）来监控我正在闪亮运行的管道的完成情况。

有6个进度条。管道由上传文件和随后单击 "actionButton" (inputId=action) 启动。但是，在我上传文件之前，有 3 个进度条会暂时出现。然后当我运行管道时，它们以错误的顺序出现，即应该在第一位的管道出现在第二位等等。

谁能告诉我为什么会发生这种情况以及我该如何纠正它？以下是管道的示例：

#ui.R
shinyUI(fluidPage(
  titlePanel("Uploading Files"),
  sidebarLayout(
    sidebarPanel(
      fileInput('file1', 'Choose CSV File',
                accept=c('text/csv', 
                                 'text/comma-separated-values,text/plain', 
                                 '.csv')),
      tags$hr(),
      checkboxInput('header', 'Header', TRUE),
      radioButtons('sep', 'Separator',
                   c(Comma=',',
                     Semicolon=';',
                     Tab='\t'),
                   ','),
      radioButtons('quote', 'Quote',
                   c(None='',
                     'Double Quote'='"',
                     'Single Quote'="'"),
                   '"')
    ),
    mainPanel(
      plotOutput('plot')
    )
  )
))


#server.R
server <- function(input, output, session) {
  read <- reactive({
  dataInput <- eventReactive(input$action{
    inFile <- input$file1
    if (is.null(inFile))
      return(NULL)
    isolate(file<-read.csv(inFile$datapath, header = input$header,
                       sep = input$sep))
    file
  })
  file_data_manipulated<-reactive({
                withProgress(message = 'Please Wait',
                 detail = 'This may take a while...', value = 0, {
                   for (i in 1:15) {
                     incProgress(1/15)
                     Sys.sleep(0.25)
                   }
                as.numeric(dataInput())
                   })
                })
  output$plot<-renderPlot({
    withProgress(message = 'Please Wait',
                 detail = 'This may take a while...', value = 0, {
                   for (i in 1:15) {
                     incProgress(1/15)
                     Sys.sleep(0.25)
                   }
                   plot(file_data_manipulated(), main = "Sample clustering to detect outliers", sub="", xlab="", cex.lab = 1.5, cex.axis = 1.5, cex.main = 2)
                   abline(h = input$cutoff_filter, col = "red")
                   #legend("bottomleft", scc$csize>1, pt.bg=unique(node_colors), pch=21)
                 })

  })

Answer 1

我认为您的代码不完整。之前出现进度条是因为一旦调用服务器函数，反应函数内的所有代码都会被执行，你需要提供机制来控制何时显示进度条。在这种情况下，只需使用 if 检查文件是否正确上传就足够了。

我修改了您的代码以展示如何控制反应函数。由于我不知道你的输入文件如何，我只是绘制了一些基本数据。另外，我不知道你是如何使用 read <- reactive({，所以把它删除了。

library(shiny)

ui <- shinyUI(fluidPage(
  titlePanel("Uploading Files"),
  sidebarLayout(
    sidebarPanel(
      fileInput('file1', 'Choose CSV File',
                accept=c('text/csv', 
                                 'text/comma-separated-values,text/plain', 
                                 '.csv')),
      tags$hr(),
      checkboxInput('header', 'Header', TRUE),
      radioButtons('sep', 'Separator',
                   c(Comma=',',
                     Semicolon=';',
                     Tab='\t'),
                   ','),
      radioButtons('quote', 'Quote',
                   c(None='',
                     'Double Quote'='"',
                     'Single Quote'="'"),
                   '"'),
      br(),
      actionButton('action', 'action')
    ),
    mainPanel(
      plotOutput('plot')
    )
  )
))

server <- function(input, output, session) {
  dataInput <- eventReactive(input$action, {
    inFile <- input$file1
    if (is.null(inFile))
      return(NULL)
    isolate({
      file <- read.csv(inFile$datapath, header = input$header,
                       sep = input$sep)
    })
    file
  })
  file_data_manipulated <- reactive({
    input$action
    if (is.null(dataInput()))
      return(NULL)
    withProgress(message = 'Please Wait 1',
      detail = 'This may take a while...', value = 0, {
        for (i in 1:15) {
           incProgress(1/15)
           Sys.sleep(0.25)
        }
        as.numeric(dataInput())
      })
  })
  output$plot <- renderPlot({
    input$action
    if (is.null(dataInput()))
      return(NULL)
    withProgress(message = 'Please Wait 2',
      detail = 'This may take a while...', value = 0, {
        for (i in 1:15) {
          incProgress(1/15)
          Sys.sleep(0.25)
        }
        # plot(file_data_manipulated(), main = "Sample clustering to detect outliers", 
          # sub="", xlab="", cex.lab = 1.5, cex.axis = 1.5, cex.main = 2)
        # abline(h = input$cutoff_filter, col = "red")
        #legend("bottomleft", scc$csize>1, pt.bg=unique(node_colors), pch=21)
        plot(sin, -pi, 2*pi)
      })
  })
}

runApp(list(ui = ui, server = server))

闪亮的进度条过早出现

shiny progress bar appearing prematurely

progress-bar

shiny