GeneC
GeneC

Reputation: 145

Resetting data in R shiny app when file upload fields change

I have an R shiny app which takes one or more file uploads, processes the data, and presents some tables and charts. The number of file upload fields is dynamically generated based on a fileCount numericInput field. When the fileCount field is changed by the user, the file uploads disappear ("no file selected" is displayed in the UI), but the tables and plots of stale data are still presented. I haven't figured out a way to invalidate this data. I wonder if it's an issue with the file input fields being generated on the fly so that shiny doesn't realize that the functions reading the files need to be rerun.

Trimmed code is here:

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

} )

Upvotes: 0

Views: 2132

Answers (1)

John Townsend
John Townsend

Reputation: 21

I know this was posted a few months ago, but I came across the issue recently and it was a complete pain, so I thought I'd share in case anyone was still wondering how to fix this.

I've mocked up a little example which shows the problem. The issue seems to be that when the fileInput buttons are re-rendered, they appear blank on the UI, but their value is not set back to NULL and their old value is retained.

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

Unfortunately, there doesn't seem to be a way to get the fileInput button to genuinely reset to NULL. However, we can create a reactiveValue and use some observers to keep track of whether or not there is genuinely a file uploaded. The reactiveValue is a vector whose length is the number of fileInput buttons. Each element is marked TRUE or FALSE, indicating whether or not new data has been uploaded.

Within the loop which generates a table and text for each fileInput button, we can put an observeEvent, which will monitor a particular fileInput button and update the appropriate element of the reactiveValue to TRUE if the fileInput button is updated (i.e. if data is uploaded):

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

Outside of this loop, we put another observeEvent, which will monitor whether the number of fileInput buttons changes. In the event that it does, all elements of the reactiveValue are set back to FALSE:

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

The other important thing to note is that both observers will activate when the number of fileInput buttons is changed, so we need to add priorities to both of them to ensure that the observer which sets everything to FALSE runs after the one which can set elements to TRUE. Also note that the priority of the observer which contains the entire loop has to be updated to 2 (see the full example below).

So now that we have a system to keep track of whether there is genuinely any data uploaded to a fileInput button, we can tell any outputs which are dependent on the fileInput buttons not to render if the user hasn't uploaded any new data:

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

So putting all that together gives an updated server.R which will not display a table unless new data is uploaded. In this example, I've also written a couple of extra lines which will paste the value of the reactiveValue to the console, so that anyone using the example can see what the observers are doing.

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

Hope this all makes sense and you still find it useful.

Cheers, John

Upvotes: 2

Related Questions