閃亮的進度條過早出現

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