How to validate csv file for upload via fileInput function in shiny App?-CodePudding

In running the below "abbreviated code", I'm trying to create a file upload validation that the csv to be uploaded must have "Scenario 1" and "Scenario 1" in cells A1 and B1 of the csv. Otherwise the file isn't uploaded and it is flagged "invalid". Any ideas of how to do this?

If you run the below, click the single action button and save the matrix inputs by clicking the button in the bottom of the modal dialog, look at the downloaded csv, and see how cells A1 and B1 show "Scenario 1" and "Scenario 1" from the downloaded matrix. This is good. If you delete these, and save the csv, you'll see that this modified csv can still be uploaded when running the App. I'd like those 2 csv fields to serve as a validation flag.

I really like the try() function as a catch-all test in this App.

Abbreviated code:

library(dplyr)
library(shiny)
library(shinyFeedback)
library(shinyMatrix)

sumMat <- function(x){return(rep(sum(x,na.rm = TRUE), 10))}

ui <- fluidPage(
  useShinyFeedback(),
  sidebarLayout(
    sidebarPanel(
      actionButton("matrix3show","Click for matrix input"),
    ),
    mainPanel(plotOutput("plot"))
  )
)

server <- function(input, output, session) {
  
  uploadMat3Data <- reactive({
    req(input$uploadMat3)
    validate(need(identical(tools::file_ext(input$uploadMat3$datapath),"csv"),"Invalid"))
    try(read.csv(input$uploadMat3$datapath, header = TRUE))
  })
  
  observeEvent(uploadMat3Data(), {
    if(is.data.frame(uploadMat3Data())){
          updateMatrixInput(session,"matrix3",as.matrix(uploadMat3Data()))
          hideFeedback("file")
          } 
    else {showFeedbackWarning("file", "Invalid")}
  })
  
  observeEvent(input$matrix3show,{
    showModal(
      modalDialog(
        fileInput(inputId = "uploadMat3",label = NULL,accept = ".csv"),
        matrixInput(
            inputId = "matrix3",
            value = if(is.null(input$matrix3)){matrix(c(1,5),ncol=2,dimnames=list(NULL,rep("Scenario 1",2)))}
                    else {input$matrix3},
            rows = list(extend = TRUE, delete = TRUE),
            cols = list(extend = TRUE, delta = 2, delete = TRUE, multiheader = TRUE),
            class = "numeric"),
        output$verbMat3 <- renderPrint(class(uploadMat3Data())),
        footer = 
          tagList(
            downloadButton("saveMat3","Save",style = "width:80px;"),
            modalButton("Exit box")
          ) # close tag list
      ))
  })

  observeEvent(input$matrix3, {
    tmpMat3 <- input$matrix3
    colnames(tmpMat3) <- paste("Scenario",rep(1:ncol(tmpMat3),each=2,length.out=ncol(tmpMat3)))
    rownames(tmpMat3) <- paste("Row", seq_len(nrow(input$matrix3)))
    updateMatrixInput(session,inputId="matrix3",value=tmpMat3)
  })
  
  data <- function(){tibble(X = seq_len(10),Y = sumMat(input$matrix3))}  
  
  output$plot<-renderPlot({plot(data(),type="l")})
  
  output$saveMat3 <- downloadHandler(
    filename = function(){paste("Inputs","csv",sep=".")},
    content = function(file){write.csv(input$matrix3, file,row.names=FALSE)}
  )
}

shinyApp(ui, server)

CodePudding user response：

To resolve I changed the observeEvent for uploadMat3Data() to the following:

observeEvent(uploadMat3Data(), {
    if(is.data.frame(uploadMat3Data()) 
       && colnames(uploadMat3Data()[1]) == "Scenario.1"
       && colnames(uploadMat3Data()[2]) == "Scenario.1.1"
       ){
          updateMatrixInput(session,"matrix3",as.matrix(uploadMat3Data()))
          hideFeedback("uploadMat3")
          } 
    else {showFeedbackWarning("uploadMat3", "Invalid")}
  })

Note the additions of && colnames(... where the code peeks into the headers for the uploaded data frame and checks for the required headers. Also note that in the original code the id references in hideFeedback() and showFeedbackWarning() were incorrect; they are now corrected to "uploadMat3"