上传到 Shiny App 时如何更完整地验证 CSV 文件？

Question

现在在最底部 posted 完整的解析代码，反映了 M. Jagan 提供的解决方案。此代码提供了数据上传（具有强大的数据验证）和用户输入下载的完整周期。您可以看到 try() 函数如何“测试”上传以避免应用程序不必要地崩溃。

当运行以下代码时，用户可以上传和下载输入数据。用户可以下载并保存输入，然后通过上传检索这些输入。我正在尝试改进上传验证，因为实际上用户很容易 select 一个不正确的文件，我宁愿用警告标记而不是像现在这样让应用程序崩溃。

所有下载都保存为一个包含 headers X 和 Y 的 2 列矩阵。这（以及它是 CSV 的事实）是我根据以下代码进行的关键上传验证。该应用程序正确下载和上传 CSV 数据，如下图 1（下载）和图 2（上传）所示，但当它尝试按照下面的图 3 上传格式不正确的 CSV 数据时崩溃。

所以我的问题是：

如何指定 csv 文件中的哪些列来查找“X”和“Y”headers？目前，它到处读取 X 和 Y headers。我尝试了 read.csv(...colClasses=c(NA, NA)))，如下所示，我也尝试了 read.csv(...)[ , 1:2]，但都没有用。
更一般地说，如果上传会导致错误或崩溃，是否有办法中止上传？有点像 Excel

if(iserror(...))

好的，现在我正在推送，如果这太多了，请随时忽略它。有什么方法可以将上传警告移至 modalDialog？在解决上述问题后，如果我无法弄明白，我总是可以将其移至另一个 post。

MWE 代码：

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

interpol <- function(a, b) { # a = periods, b = matrix inputs
  c <- rep(NA, a)
  c[1] <- b[1]
  c[a] <- b[2]
  c <- approx(seq_along(c)[!is.na(c)], c[!is.na(c)], seq_along(c))$y 
  return(c)
}

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      fileInput("file1", "Optionally choose input file (csv)", accept = ".csv"),
      sliderInput('periods', 'Periods to interpolate over:', min=1, max=10, value=10),
      matrixInput("matrix1", 
                  value = matrix(c(1,5), 
                          ncol = 2, 
                          dimnames = list("Interpolate",c("X","Y"))
                  ),
                  cols =  list(names = TRUE),
                  class = "numeric"
      ),
      downloadButton("download")
    ),
    mainPanel(
      tableOutput("contents"),
      plotOutput("plot")
    )
  )
)

server <- function(input, output, session) {
  
  input_file <- reactive({
    file <- input$file1
    ext <- tools::file_ext(file$datapath)
    req(file)
    
    if(is.null(file))
      return(NULL)
    
    file_contents <- read.csv(file$datapath,header=TRUE,colClasses=c(NA, NA))
    required_columns <- c('X','Y')
    column_names <- colnames(file_contents)
    
    shiny::validate(
      need(ext == "csv", "Incorrect file type"),
      need(required_columns %in% column_names, "Incorrect file type")
    )
    
    file_contents
    
  })
  
  output$contents <- renderTable({
    input_file()
  })
  
  data <- function(){
    tibble(
      X = seq_len(input$periods),
      Y = interpol(input$periods,matrix(c(input$matrix1[1,1],input$matrix1[1,2])))
    )
  }  
  
  output$plot<-renderPlot({plot(data(),type="l",xlab="Periods (X)", ylab="Interpolated Y values")})
  
  observeEvent(input$file1,{
    updateMatrixInput(session, 
                      inputId = "matrix1", 
                      value = matrix(as.matrix(input_file()),
                                     ncol=2,
                                     dimnames = list("Interpolate",c("X","Y"))
                              )
    )
                      
  })
  
  output$download <- downloadHandler(
    filename = function() {
      paste("Inputs","csv",sep=".")
    },
    content = function(file) {
      write.csv(input$matrix1, file,row.names=FALSE)
    }
  )
}

shinyApp(ui, server)

现在解析代码：

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

nms <- c("X", "Y") # < Matrix variable names (headers)

interpol <- function(a, b) { # < a = periods, b = matrix inputs
  c <- rep(NA, a)
  c[1] <- b[1]
  c[a] <- b[2]
  c <- approx(seq_along(c)[!is.na(c)], c[!is.na(c)], seq_along(c))$y 
  return(c)
}

ui <- fluidPage(
  useShinyFeedback(),
  sidebarLayout(
    sidebarPanel(
      fileInput("file", "Optionally choose input file (csv)", accept = ".csv"),
      sliderInput('periods', 'Periods to interpolate over:', min=1, max=10, value=10),
      matrixInput("matrix1", 
                  "Values to interpolate:",
                  value = matrix(c(1,5),ncol = 2,dimnames = list(NULL,nms)),
                  cols =  list(names = TRUE),
                  rows = list(names = FALSE),
                  class = "numeric"
      ),
      downloadButton("download")
    ),
    mainPanel(
      tableOutput("contents"),
      plotOutput("plot"),
      verbatimTextOutput("verb")
    )
  )
)

server <- function(input, output, session) {
  uploadData <- reactive({
    req(input$file)
    validate(need(identical(tools::file_ext(input$file$datapath),"csv"),"Invalid extension"))
    try(read.csv(input$file$datapath, header = TRUE))
  })
  
  observeEvent(uploadData(), {
    if(is.data.frame(uploadData()) && 
       all(nms %in% names(uploadData())) && 
       all(vapply(uploadData()[nms],is.numeric,NA))){
          updateMatrixInput(session,"matrix1",as.matrix(uploadData()[nms]))
          hideFeedback("file")
        } 
    else {
      showFeedbackWarning("file", "Invalid upload.")
    }
  })

  data <- function(){
    tibble(
      X = seq_len(input$periods),
      Y = interpol(input$periods,matrix(c(input$matrix1[1,1],input$matrix1[1,2])))
    )
  }  
  
  output$plot<-renderPlot({plot(data(),type="l",xlab="Periods (X)", ylab="Interpolated Y values")})
  output$verb <- renderPrint(class(uploadData()))  
  
  output$download <- downloadHandler(
    filename = function() {
      paste("Inputs","csv",sep=".")
    },
    content = function(file) {
      write.csv(input$matrix1, file,row.names=FALSE)
    }
  )
}

shinyApp(ui, server)

Answer 1

以下应满足您的需求

shiny::validate(
  need(ext == "csv", "Incorrect file type"),
  need(required_columns %in% column_names, "Incorrect file type"),
  need(sum(!column_names %in% required_columns)==0, "Incorrect columns in file")
)

更新：如果您可以修改支票，则可以执行以下操作。

shiny::validate(
  need(ext == "csv", "Incorrect file type"),
  need(sum(required_columns %in% column_names)==2 & sum(!column_names %in% required_columns)==0, "Incorrect file type")
)

Answer 2

我已经为你的应用程序创建了一个最小版本（没有插值或下载），我认为它解决了 (1) 和 (2) 以及你希望在无效的情况下保留现有矩阵和绘图上传发生。您应该能够通过修改此框架来重建您的应用程序，但在此之前，您应该尝试了解此应用程序的工作原理。

请注意，我已经添加了对包 shinyFeedback 的依赖，它将警告消息放置在适当的输入面板附近。让我知道这是否有问题...

library("shiny")
library("shinyFeedback")
library("shinyMatrix")

## Your variable names
nms <- c("X", "Y")

ui <- fluidPage(
  useShinyFeedback(),
  sidebarLayout(
    sidebarPanel(
      fileInput("file", label = "CSV file", accept = ".csv"),
      matrixInput("mat", label = "Matrix", value = matrix(rnorm(12L), 6L, 2L, dimnames = list(NULL, nms)), class = "numeric", rows = list(names = FALSE))
    ),
    mainPanel(
      plotOutput("plot"),
      verbatimTextOutput("verb")
    )
  )
)

server <- function(input, output, session) {
  rawdata <- reactive({
    req(input$file)
    try(read.csv(input$file$datapath, header = TRUE))
  })

  observeEvent(rawdata(), {
    ## If 'rawdata()' is a data frame with numeric variables named 'nms'
    if (is.data.frame(rawdata()) && all(nms %in% names(rawdata())) && all(vapply(rawdata()[nms], is.numeric, NA))) {
      ## Then update matrix by extracting those variables, ignoring the rest (if any)
      updateMatrixInput(session, "mat", as.matrix(rawdata()[nms]))
      ## And suppress warning if visible
      hideFeedback("file")
    } else {
      ## Otherwise show warning
      showFeedbackWarning("file", "Invalid upload.")
    }
  })
  
  ## Plots matrix rows as points
  output$plot <- renderPlot(plot(input$mat))
  ## Prints "try-error" if 'read.csv' threw error, "data.frame" otherwise
  output$verb <- renderPrint(class(rawdata()))  
}

shinyApp(ui, server)

这是您可以用来创建测试文件的代码。每个测试应用程序的不同行为。

## OK
cat("X,Y,Z\na,1,3,5\nb,2,4,6\n", file = "test1.csv")
## OK: file contents matter, not file extension
cat("X,Y,Z\na,1,3,5\nb,2,4,6\n", file = "test2.txt")
## Missing 'X'
cat("W,Y,Z\na,1,3,5\nb,2,4,6\n", file = "test3.csv")
## 'X' is not numeric
cat("X,Y,Z\na,hello,3,5\nb,world,4,6\n", file = "test4.csv")
## Not a valid CSV file
cat("read.csv\nwill,not,like,this,file\n", file = "test5.csv")

上传到 Shiny App 时如何更完整地验证 CSV 文件？

How to more completely validate CSV file when uploading to Shiny App?

validation

upload

r

shiny