Shiny学习笔记:数据上传下载

app与用户之间的数据交换是非常常见的，我们需要上传数据用以分析，下载结果报告等数据。

数据上传

UI

数据上传由fileInput()实现，fileInput()只需要两个参数：id,label:

ui <- fluidPage(
  fileInput("file", "Upload a file")
)

Server

server端接收上传的数据更复杂点，input$file返回的是一个含有四列的数据框：

• name：用户上传时的文件名

• size：文件大小，默认上传数据不超过5MB，可以在Shiny最开始的时候设置文件大小限制，比如允许上传不超过10MB的数据：options(shiny.maxRequestSize = 10 * 1024^2)

• type：文件类型，一般后缀已经注明了

• datapath：数据上传之后的路径，后续读取的时候要用到

创建一个简单的app演示一下：上传数据，并打印出数据信息

library(shiny)
options(shiny.maxRequestSize = 10 * 1024^2)
ui <- fluidPage(
  fileInput("upload", label = "Please Upload Your File", buttonLabel = "Upload...", multiple = TRUE),
  tableOutput("files")
)
server <- function(input, output, session) {
  output$files <- renderTable(input$upload)
}
shinyApp(ui, server)

上传数据有几点需要注意：

• input$file：初始值是NULL，所以需要req(input$file)保证数据上传完开始运行计算
• accept：accept参数允许限制上传数据的类型，比如可以限制只允许上传.csv,.tsv,.txt文件:accept=c(".csv",".tsv","txt")

比如下面这个app只允许上传.csv,.tsv,.txt文件，如果不是就提醒用户，上传完毕之后读取并打印：

library(shiny)
options(shiny.maxRequestSize = 10 * 1024^2)
ui <- fluidPage(
  fileInput("file", label = "Please upload file: ", accept = c(".csv", ".tsv", ".txt")),
  numericInput("n", "Rows", value = 5, min = 1, step = 1),
  tableOutput("head")
)

server <- function(input, output, session) {
  data <- reactive({
    req(input$file)
    
    ext <- tools::file_ext(input$file$name)
    switch(ext,
           csv = vroom::vroom(input$file$datapath, delim = ","),
           tsv = vroom::vroom(input$file$datapath, delim = "\t"),
           txt = vroom::vroom(input$file$datapath, delim = "\t"),
           validate("Invalid file; Please upload a .csv, .tsv or a .txt file")
    )
  })
  
  output$head <- renderTable({
    head(data(), input$n)
  })
}
shinyApp(ui, server)

数据下载

数据下载由downloadButton(id)以及downloadLink(id)提供下载按钮，这两个函数还有很多定制化参数进行美化，downloadHandler()负责下载

ui <- fluidPage(
  downloadButton("download1"),
  downloadLink("download2")
)

output$download <- downloadHandler(
  filename = function() {
    paste0(input$dataset, ".csv")
  },
  content = function(file) {
    write.csv(data(), file)
  }
)

downloadHandler()有两个参数：

• filename：是一个函数，返回文件名。主要作用就是创建展示给用户的文件名
• content：也是一个函数，返回文件保存路径

下面用一个小app来展示：

library(shiny)
ui <- fluidPage(
  selectInput("dataset", "Pick a dataset", ls("package:datasets")),
  tableOutput("preview"),
  downloadButton("download", "Download .tsv")
)

server <- function(input, output, session) {
  data <- reactive({
    out <- get(input$dataset, "package:datasets")
    if (!is.data.frame(out)) {
      validate(paste0("'", input$dataset, "' is not a data frame"))
    }
    out
  })
  
  output$preview <- renderTable({
    head(data())
  })
  
  output$download <- downloadHandler(
    filename = function() {
      paste0(input$dataset, ".tsv")
    },
    content = function(file) {
      vroom::vroom_write(data(), file)
    }
  )
}
shinyApp(ui, server)

最后用一个app将数据上传，数据下载整合到一起展示，这里将几部分先写好再整合到一个app中，实际上算是个模块化编程了，方便理解：

#上传数据ui
ui_upload <- sidebarLayout(
  sidebarPanel(
    fileInput("file", "Data", buttonLabel = "Upload..."),
    textInput("delim", "Delimiter (leave blank to guess)", ""),
    numericInput("skip", "Rows to skip", 0, min = 0),
    numericInput("rows", "Rows to preview", 10, min = 1)
  ),
  mainPanel(
    h3("Raw data"),
    tableOutput("preview1")
  )
)

##处理数据ui
ui_clean <- sidebarLayout(
  sidebarPanel(
    checkboxInput("snake", "Rename columns to snake case?"),
    checkboxInput("constant", "Remove constant columns?"),
    checkboxInput("empty", "Remove empty cols?")
  ),
  mainPanel(
    h3("Cleaner data"),
    tableOutput("preview2")
  )
)

##下载数据ui
ui_download <- fluidRow(
  column(width = 12, downloadButton("download", class = "btn-block"))
)

再整合成UI：

ui <- fluidPage(
  ui_upload,
  ui_clean,
  ui_download
)

最后写成一个app

server <- function(input, output, session) {
  # Upload ---------------------------------------------------------------
  raw <- reactive({
    req(input$file)
    delim <- if (input$delim == "") NULL else input$delim
    vroom::vroom(input$file$datapath, delim = delim, skip = input$skip)
  })
  output$preview1 <- renderTable(head(raw(), input$rows))
  
  # Clean ----------------------------------------------------------------
  tidied <- reactive({
    out <- raw()
    if (input$snake) {
      names(out) <- janitor::make_clean_names(names(out))
    }
    if (input$empty) {
      out <- janitor::remove_empty(out, "cols")
    }
    if (input$constant) {
      out <- janitor::remove_constant(out)
    }
    
    out
  })
  output$preview2 <- renderTable(head(tidied(), input$rows))
  
  # Download -------------------------------------------------------------
  output$download <- downloadHandler(
    filename = function() {
      paste0(tools::file_path_sans_ext(input$file$name), ".tsv")
    },
    content = function(file) {
      vroom::vroom_write(tidied(), file)
    }
  )
}

参考：https://mastering-shiny.org/action-transfer.html#download