如何下载用于在 R shiny 中生成选定行的源数据

How to download the source data used to generated the selected rows in R shiny

我正在尝试下载用于在 DT table 中生成选定行的源数据 (mpg)。 table 显示基于来自源数据的输入石斑鱼的聚合结果。

我尝试过: 首先使用 _rows_selected 函数获取行号, 然后在石斑鱼列中累积一个值列表, 然后在源数据中识别这些值的行索引, 然后根据这些行索引和源数据编写导出的 csv。

但它似乎没有用,我也不知道为什么。


library(datasets)
library(shiny)
library(dplyr)
library(plotly)
library(ggplot2)
library(DT)
library(crosstalk)

data("mpg")
mpg = data.frame(mpg)
#convert all column input from character to factor (or assure they are all factor)
for(i in 1:dim(mpg)[2]){
  mpg[,i] = type.convert(mpg[,i])
  i = i+1
}

#mpg$manufacturer = type.convert(mpg$manufacturer)

# Define UI for application that draws a histogram
ui <- fluidPage(

  # Application title
  titlePanel("Analyze MPG table"),

  # Sidebar with a dropdown menu selection input for key meausre component
  sidebarLayout(
    sidebarPanel(
      selectInput("yInput", "Measuring element: ", 
                  colnames(mpg), selected = colnames(mpg)[9]), 
      selectInput('xInput', 'Grouper: ', 
                  colnames(mpg), selected = colnames(mpg)[1]), 
      selectInput('xInput2', 'Filter Column: ', 
                  colnames(mpg), selected = colnames(mpg)[2]),
      p(downloadButton('x0', 'Download Source Data of Selected Rows', 
                       class = 'text-center'))
    ),

    # Show a plot of the generated distribution
    mainPanel(
      uiOutput('filter'),
      plotlyOutput("barPlot"),
      DTOutput('table1')

    )
  )
)



server <- function(input, output) {


  output$filter = renderUI({
    selectInput('inputF2', 'Filter Item: ', 
                c('No Filter', unique(mpg %>% select(input$xInput2))))
  })



  mpg_sub <- reactive({  
    if (req(input$inputF2) != 'No Filter') {
      mpg_sub <- mpg %>% filter_at(vars(input$xInput2), any_vars(. == input$inputF2))
    } else{
      mpg_sub <- mpg
    }
    return(mpg_sub)
  })



  by_xInput <- reactive({  
    mpg_sub() %>% 
      group_by_at(input$xInput) %>% 
      # n() can replace the length
      # convert string to symbol and evaluate (!!)
      summarize(n = n(), mean_y = mean(!! rlang::sym(input$yInput)))
  })



  output$table1 = renderDT(
    datatable(by_xInput(), 
              extensions = 'Buttons', 
              options = list(dom = 'Bfrtip',
                             buttons = c('copy', 'csv', 'excel', 'pdf', 'print'))

              )
  )

  #####here is where I have the issue... 

  output$x0 = downloadHandler(
    'Source Data_selected.csv', 
    content = function(file){
      s0 = input$table1_rows_selected
      grouper = by_xInput()[s0, 1]
      big = mpg_sub()[, match(as.character(input$xInput), colnames(mpg_sub()))]
      position = which(!is.na(match(big, grouper)))

      write.csv(mpg_sub()[position, , drop = F], file)
    }
  )




}


shinyApp(ui = ui, server = server)

有些东西似乎是必需的:

  1. 将评论中的 input$inputC1 更正为 input$xInput
  2. biggrouper 似乎是小标题,而不是向量。如下更改 match 语句以从 tibble 获取单列作为向量。
  3. position 应该是要从 mpg_sub() 中提取的行,而不是列。将 position 放在逗号前。

如果可行,请告诉我。

output$x0 = downloadHandler(
    'Source Data_selected.csv', 
    content = function(file){
      s0 = input$table1_rows_selected
      grouper = by_xInput()[s0, 1]
      big = mpg_sub()[, match(as.character(input$xInput), colnames(mpg_sub()))]
      position = which(!is.na(match(big[[1]], grouper[[1]])))
      write.csv(mpg_sub()[position , , drop = F], file)
    }
  )

Ben 的回答适用于原始 mpg 数据; 如果 mpg 被格式化为 data.frame,这将起作用。 本的评论对我想出这个解决方案帮助很大!!


output$x0 = downloadHandler(
    'Source Data_selected.csv', 
    content = function(file){
      s0 = input$table1_rows_selected
      grouper = by_xInput()[s0, 1]

      big2 = mpg_sub() %>% pull(!!rlang::sym(input$xInput))
      position2 = which(!is.na(match(big2, grouper[[1]])))

      write.csv(mpg_sub()[position2 , , drop = F], file)
    }
  )