闪亮的进度条过早出现

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))