在R中下載2個子集文件-Shiny

Question

我正在為我們的合作伙伴創建一個應用程序，使他們可以上傳自己的csv聯系人列表，從該文件中隨機采樣一個組，然后讓他們為每個采樣組和其余組分別下載csv。 一切似乎都運行良好，並且沒有收到任何錯誤代碼，但是當我嘗試下載已解析的數據幀時，僅獲得完整的原始列表。 我假設這與file參數有關，可能引用了在文件上載期間創建的文件路徑，但是我不知道足以驗證和/或修改此過程以進行測試。

代碼不是很長，並且認為對您來說，復制應用程序可能是最好的選擇，因此下面是整個示例（或多或少）

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"))
        )
      )
    )
  )
)

server.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沒有。 在瀏覽器中啟動了應用程序，並按預期下載了文件。