光沢のあるプログレスバーが途中で表示される

Question

私は光沢のあるパイプラインの完成を監視するためにプログレスバー（ 'withProgress'コマンド）を使用しようとしています。

6つのプログレスバーがあります。パイプラインは、ファイルのアップロードとその後の「actionButton」のクリック（inputId = action）によって開始されます。ただし、ファイルをアップロードする前に、進行状況バーの3つが一時的に表示されます。パイプラインを実行すると、間違った順序で表示されます。つまり、先に最初に表示されるべきものが2番目に表示されます。

これはどうして起こるかもしれないのですか？以下 は、パイプラインがどのように見えるかのサンプルです：

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