在 R 中下载 2 个子集文件 - Shiny

Question

我正在为我们的合作伙伴创建一个应用程序，让他们上传自己的 csv 联系人列表，从该文件中随机抽取一个组，然后让他们为每个抽样组和其余组下载单独的 csv。一切似乎都运行良好，我没有收到错误代码，但是当我尝试下载解析的数据帧时，我只得到了完整的原始列表。我假设这与可能引用文件上传期间创建的文件路径的文件参数有关，但我不知道能够验证和/或修改此过程以进行测试。

代码不是很长，并且认为最好能够复制应用程序，所以下面是整个 shebang（或多或少）

ui.r

library(shiny)
source('server.R')

shinyUI(fluidPage(

  sidebarLayout(
    sidebarPanel(
      fileInput("file1", "Choose a CSV file:",
                accept = c('text/csv',
                           'text/comma-separated-values',
                           'text/plain',
                           '.csv')),
      tags$hr(),
      checkboxInput("header", "This file has headers.", FALSE),
      radioButtons("sep", "What kind of separators does this file use?",
                   c(Comma = ',',
                     Semicolon = ';',
                     Tab = '\t'),
                   ','),
      radioButtons('quote', 
                   "Are any of the values in this table surrounded by
                   quotation marks?  i.e. 'Adam Smith'",
                   c("None" = '',
                     "Double Quotes (\" \")" = '"',
                     "Single Quotes (\' \')" = "'"),
                   ''), 

      h3("Sample creation"),

      numericInput("sampleSize", 
                   "How many entries would you like for your sample?",
                   value = 0,
                   step = 1),
      conditionalPanel(
        condition = "output.recommend !== NULL",
        textOutput("recommend"))
    ), 

    mainPanel(
      tabsetPanel(
        tabPanel("Original Table", tableOutput("contents")),
        tabPanel("Sample Group", downloadButton("sampleDL", 
                 "Download this table"), 
                 tableOutput("sampled")),
        tabPanel("Remaining Group", downloadButton("remainDL", 
                 "Download this table"),
                 tableOutput("remains"))
        )
      )
    )
  )
)

服务器.R

library(shiny)

shinyServer(function(input, output) {

  dataset <- reactive({
    if(is.null(input$file1)){
      return(NULL)
    } else {
      info <- input$file1
      data <- read.csv(info$datapath, header=input$header, 
              sep=input$sep, quote=input$quote)
      entID <- 1:(as.integer(nrow(data)))
      dataset <- data.frame(entID, data)
      cbind(dataset)
      dataset[sample(1:nrow(dataset)),]
      return(dataset)
    }
  })

  sugSample <- function(){
    dataset <- dataset()
    if(is.null(dataset)){
      return(NULL)
    } else {
      size <- nrow(dataset)
      if(size <= 3){
        return(NULL)
      }else {
        sSize <- size * 0.167
        return(as.integer(sSize))
      }
    }
  }

  output$recommend <- renderText({
    sugSample <- sugSample() 
    if(is.null(sugSample)){
      return("There is nothing from which to sample at this time.")
    } else {
      return(paste0("Based on the size of your dataset, 
                    I recommend choosing at least ", 
                    sugSample, 
                    " entries for your sample size."))
    }
 })

  sampleGroup <- reactive({
  sSize <- input$sampleSize  
  if(sSize == 0){
      x <- "there is nothing to display"
      y <- "there is nothing to display"
      z <- "there is nothing to display"
      blank <- data.frame(x,y,z)
      return(blank)
    } else {
      dataset <- dataset()
      oSize <- as.integer(nrow(dataset))
      sampleGroup <- dataset[(sample(1:oSize, sSize, replace = FALSE)),]
      return(data.frame(sampleGroup))
    }
  })

  remainGroup <- reactive({
    if(input$sampleSize == 0){
      x <- "there is nothing to display"
      y <- "there is nothing to display"
      z <- "there is nothing to display"
      blank <- data.frame(x,y,z)
      return(blank)
    } else {
    dataset <- dataset()
    sampleGroup <- sampleGroup()
    remainGroup <- dataset[which(!(dataset$entID %in% sampleGroup$entID)),]
    return(data.frame(remainGroup))
    }
  })

  output$contents <- renderTable({
    dataset <- dataset()
    if(is.null(dataset)){
      x <- 'there is nothing to display'
      y <- 'there is nothing to display'
      z <- 'there is nothing to display'
      blank <- data.frame(x,y,z)
      return(blank)
    } else {
      return(dataset)
    }
    })

  output$sampled <- renderTable({
    sampleGroup <- sampleGroup()
    return(sampleGroup)
  })

  output$sampleDL <- downloadHandler(
    filename = 'sampleGroup.csv',
    content = function(file){
      write.csv(sampleGroup(), file)
    })

  output$remains <- renderTable({
    remainGroup <- remainGroup()
    return(remainGroup)
  })

  output$remainDL <- downloadHandler(
    filename = 'remainingGroup.csv',
    content = function(file){
      write.csv(remainGroup(), file)
    })
})

谢谢！

Answer 1

downloadHandler() 在 RStudio 中无法按预期运行，因为进程需要 Flash，而 RStudio 没有。在浏览器中启动应用程序并按预期下载文件。