【发布时间】：2021-12-30 20:05:39
【问题描述】：
现在在最底部发布了完整的解析代码，反映了 M. Jagan 提供的解决方案。此代码提供数据上传（具有强大的数据验证）和用户输入下载的完整周期。您可以看到try() 函数如何“测试”上传以避免不必要的应用崩溃。
运行以下代码时，用户可以上传和下载输入数据。用户可以下载和保存输入，然后通过上传检索这些输入。我正在尝试改进上传验证，因为实际上用户很容易选择不正确的文件，我宁愿用警告标记而不是像现在这样让应用程序崩溃。
所有下载都保存为带有 X 和 Y 标题的 2 列矩阵。这（以及它是 CSV 的事实）是我根据以下代码进行的关键上传验证。该应用程序正确下载和上传 CSV 数据，如下图 1（下载）和图 2（上传）所示，但当它尝试上传下图 3 中格式不正确的 CSV 数据时会崩溃。
所以我的问题是：
- 如何指定 csv 文件中的哪些列来查找“X”和“Y”标题？目前，它到处读取 X 和 Y 标头。我试过
read.csv(...colClasses=c(NA, NA)))，如下图，我也试过read.csv(...)[ , 1:2]，但都没有。 - 更一般地说，如果上传会导致错误或崩溃，有没有办法中止上传？有点像 Excel 中的
if(iserror(...)) - 好的，现在我正在推动它，如果这太多了，请随意忽略它。有什么方法可以将上传警告移至
modalDialog？在解决上述问题后，如果我无法弄清楚，我可以随时将其移至另一个帖子。
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)
【问题讨论】：
-
对于 (2)，您可以执行
file_contents <- try(read.csv(...))并验证is.data.frame(file_contents)是TRUE。见?try。 -
对于（1），你试过
file_contents[c("X", "Y")]吗？ -
好吧，让我研究一下 try()。基本上，如果上传和相关的连接对象（矩阵更新、绘图）导致发生一些有趣的事情，我希望忽略上传并继续前进；用户可以尝试再次上传或手动输入到矩阵中。您对 (1) 的最后评论，那会去哪里？我在几个地方都试过了，我得到了错误。
标签： r validation shiny upload