文件上载字段更改时,重置R闪亮应用程序中的数据

时间:2015-12-16 23:10:18

标签: r shiny

我有一个R闪亮的应用程序,它可以上传一个或多个文件,处理数据,并提供一些表格和图表。文件上载字段的数量是基于fileCount numericInput字段动态生成的。当用户更改fileCount字段时,文件上载消失(UI中显示“未选择文件”),但仍显示过时数据的表格和图表。我还没有找到使这些数据无效的方法。我想知道文件输入字段是否在运行中生成是一个问题,因此闪亮并没有意识到需要重新运行读取文件的函数。

修剪的代码在这里:

shinyServer( function(input,output) {

    ############### input readers
    fileCount <- reactive({
        if (! is.null(input$fileCount) & is.numeric(input$fileCount)) {
            return(input$fileCount)
        } else {
            return(0)
        }
    })

    formattedData <- reactive({
        if (fileCount() == 0) return(NULL)
        fileInputNames <- paste0("inFile.",1:fileCount())
        lapply(fileInputNames, function(fin) readData( fileObject=input[[fin]] ))
     })

    ############### UI form elements
    output$fileinput_set <- renderUI({
        fc <- fileCount()
        if (fc == 0) return(NULL)

        lapply(1:fc, function(i) {
            fileInput(
                paste0("inFile.", i),
                label = paste0("CSV File ",i),
                multiple = FALSE,
                accept = c('text/csv','text/comma-separated-values','text/plain','.csv')
            )
        })
    })

    output$dataTable <- renderTable( {
        fc <- fileCount()
        fd <- formattedData()
        if (is.null(fd) || is.null(fc)) return(data.frame())
        # attempt to blank out the table when fileCount changes
        if (fc != length(fd)) return(NULL)  
        do.call("cbind",lapply(fd, function(x) x$typeB))
    })

    output$dotPlot <- renderPlot({
        fd <- formattedData()
        if (is.null(fd)) return(NULL)
        generatePlot(fd)
    })

} )

1 个答案:

答案 0 :(得分:1)

我知道这是几个月前发布的,但我最近遇到了这个问题,这是一个彻头彻尾的痛苦,所以我想我会分享以防任何人仍然想知道如何解决这个问题。

我嘲笑了一个显示问题的小例子。问题似乎是当重新呈现fileInput按钮时,它们在UI上显示为空白,但它们的值不会设置回NULL并保留旧值。

<强> server.R:

library(shiny)

shinyServer(function(input, output) {

  #Dynamically render the fileInput buttons
  output$fileUploads <- renderUI({
    num <- input$numButtons
    tagList(lapply(1:num, function(i) {fileInput(inputId=paste0("File", i), label=paste0("Upload file ", i))}))
  })

  #Create a table and text for each file upload
  observe({
    for(i in 1:input$numButtons) {
    #Need local so each item gets its own number
    local({
      j <- i
      #Render the table
      output[[paste0("Table", j)]] <- renderTable({
        input[[paste0("File", j)]]
      })

      #Render the text
      output[[paste0("Text", j)]] <- renderText({
        paste0("Is 'input$File", j, "' NULL: ", is.null(input[[paste0("File", j)]]))
      })
    })
  }
  })

  #Dynamically render the UI to display the tables
  output$fileTables <- renderUI({
    tagList(lapply(1:input$numButtons, function(i){
      tableOutput(paste0("Table", i))
    }))
  })

  #Dynamically render the UI to display text showing whether the fileInput button is NULL
  output$fileText <- renderUI({
    tagList(lapply(1:input$numButtons, function(i){
      textOutput(paste0("Text", i))
    }))
  })
})

<强> ui.R:

library(shiny)

shinyUI(fluidPage(

  #Inputs
  column(6,
         #Indicate the number of fileInput buttons desired
         numericInput("numButtons", "Enter the number of file uploads", value=1),

         #Dynamically render the fileInput buttons
         uiOutput("fileUploads")
  ),

  #Outputs
  column(6,
         #Dynamically render tables to show the uploaded data
         uiOutput("fileTables"),

         #Dynamically render text to show whether the fileInput button is NULL
         uiOutput("fileText")
  )
))

不幸的是,似乎没有办法让fileInput按钮真正重置为NULL。但是,我们可以创建一个reactiveValue并使用一些观察者来跟踪是否真的上传了文件。 reactiveValue是一个向量,其长度是fileInput按钮的数量。每个元素都标记为TRUE或FALSE,表示是否已上传新数据。

在为每个fileInput按钮生成表和文本的循环中,我们可以放置一个observeEvent,它将监视特定的fileInput按钮,并在fileInput按钮更新时将reactiveValue的相应元素更新为TRUE(即,如果数据已上传):

observeEvent(input[[paste0("File", j)]], {
 myReactives$FileUploaded[j] <- TRUE
}, priority=2)

在这个循环之外,我们放了另一个observeEvent,它将监视fileInput按钮的数量是否发生变化。如果发生这种情况,则reactiveValue的所有元素都将设置为FALSE:

observeEvent(input$numButtons, {
  myReactives$FileUploaded <- rep(FALSE, input$numButtons)
}, priority=1)

另一个需要注意的重要事项是,当更改fileInput按钮的数量时,两个观察者都将激活,因此我们需要为它们添加优先级,以确保将所有设置为FALSE的观察者在可以执行的操作之后运行将元素设置为TRUE。另请注意,包含整个循环的观察者的优先级必须更新为2(参见下面的完整示例)。

现在我们有一个系统来跟踪是否真的有任何数据上传到fileInput按钮,我们可以告诉任何依赖于fileInput按钮的输出如果用户没有上传则不呈现任何新数据:

output[[paste0("Table", j)]] <- renderTable({
 if(myReactives$FileUploaded[j]==F) {return()}
 input[[paste0("File", j)]]
})

因此,将所有这些放在一起会产生更新的server.R,除非上传新数据,否则不会显示表格。在这个例子中,我还编写了一些额外的行,它们会将reactiveValue的值粘贴到控制台,这样任何使用该示例的人都可以看到观察者正在做什么。

更新了server.R:

library(shiny)

shinyServer(function(input, output) {

  #Dynamically render the fileInput buttons
  output$fileUploads <- renderUI({
    num <- input$numButtons
    tagList(lapply(1:num, function(i) {fileInput(inputId=paste0("File", i), label=paste0("Upload file ", i))}))
  })

  #Create a reactive value to store whether there is truly any data in the fileInput buttons
  myReactives <- reactiveValues(fileUploaded=FALSE)

  #Create a table and text for each file upload
  observe({
    for(i in 1:input$numButtons) {
      #Need local so each item gets its own number
      local({
        j <- i
        #Render the table
        output[[paste0("Table", j)]] <- renderTable({
          if(myReactives$FileUploaded[j]==F) {return()}
          input[[paste0("File", j)]]
        })

        #Render the text
        output[[paste0("Text", j)]] <- renderText({
          paste0("Is 'input$File", j, "' NULL: ", is.null(input[[paste0("File", j)]]))
        })

        #Create a reactive value which contains a logical vector, indicating whether there really is a file uploaded or not
        observeEvent(input[[paste0("File", j)]], {
          myReactives$FileUploaded[j] <- TRUE
          cat("\nFile Uploaded: ", myReactives$FileUploaded, sep="")
        }, priority=2)
      })
    }
  }, priority=2)

  #Update the reactive value to all false when 'input$numButtons' is updated
  observeEvent(input$numButtons, {
    myReactives$FileUploaded <- rep(FALSE, input$numButtons)
    cat("\nFile Uploaded: ", myReactives$FileUploaded, sep="")
  }, priority=1)

  #Dynamically render the UI to display the tables
  output$fileTables <- renderUI({
    tagList(lapply(1:input$numButtons, function(i){
      tableOutput(paste0("Table", i))
    }))
  })

  #Dynamically render the UI to display rext showing whether the fileInput button is NULL
  output$fileText <- renderUI({
    tagList(lapply(1:input$numButtons, function(i){
      textOutput(paste0("Text", i))
    }))
  })
})

希望这一切都有意义,你仍然觉得它很有用。

干杯, 约翰