R + Shiny + DT ：下载过滤数据

Question

我正在尝试做一些类似的事情

r shiny download filtrered datatables (DT)

即在 Shiny 中给定一个表格，搜索一些关键字并下载过滤后的数据集。 我需要能够下载使用按钮和选择一些关键字过滤的数据。在现实生活中，我正在处理的数据集要复杂得多，我无法事先预见所有可能的过滤器。 我提到的示例使用“reactiveValues”，而我依赖“reactive”，并且由于某些原因，我一直在用头撞墙。

在下面的表示中，如果我选择“鱼”作为动物类型并搜索“高”，我最终会得到 3 条记录，但我下载的数据集无论如何都有 10 条记录。 如何下载过滤后的数据集？

谢谢！

library(shiny)
library(shinyWidgets)
library(DT)
#> 
#> Attaching package: 'DT'
#> The following objects are masked from 'package:shiny':
#> 
#>     dataTableOutput, renderDataTable
library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union
library(readr)

### small helper function

dt_output = function(title, id) {
  fluidRow(column(
      12, h1(paste0(title)),      
      hr(), DTOutput(id)
  ))
}



df <- tibble(animal=rep(c("dog", "fish", "cat"), 10),
             code=rep(LETTERS[1:10],3),
             price_tag=c(rep("high",10),rep("average",10), rep("low",10))

             )


ui <- fluidPage(
     sidebarLayout(
         sidebarPanel(
             pickerInput("mypet","Select animal type", choices=c("cat", "dog", "fish"),
                        selected="fish",
                        options = list(`actions-box` = TRUE,
                                       `selected-text-format` = "count > 3"),multiple = T),

             downloadButton("downloadData", "Download your selection")

             )
         ,
         mainPanel(
dt_output("Raw Data Selection","table")
             
    )
     )
)



server <- function(input, output) {

    df_filter <- reactive({

        df %>%
            filter(animal %in% input$mypet)
        
    })

    output$table <- renderDT({datatable(df_filter())})

        output$downloadData <- downloadHandler(
    filename = function() {
      paste("filtered_data.csv")
    },
    content = function(file) {
      write_csv(df_filter(), file)

    }
  )

    
}


shinyApp(ui = ui, server = server)
#> 
#> Listening on http://127.0.0.1:7081

^{由reprex package (v2.0.1) 于 2021 年 9 月 28 日创建}

Answer 1

这是一种使用 datatables 按钮的方法，而不是使用下载处理程序：

  output$table <- renderDT({
    datatable(
      df_filter(),
      extensions = "Buttons",
      options = list(
        dom = "Bfrtip",
        buttons = list(
          list(
            extend = "csv",
            exportOptions = list(
              modifier = list(
                search = "applied"
              )
            )
          )
        )
      )
    )
  }, server = FALSE)

Answer 2

由于 DT 是输出，您可以创建自己的搜索框输入：

library(shiny)
library(shinyWidgets)
library(DT)
library(dplyr)


dt_output <- function(title, id) {
  fluidRow(column(
    12, h1(paste0(title)),
    hr(), DTOutput(id)
  ))
}



df <- tibble(
  animal = rep(c("dog", "fish", "cat"), 10),
  code = rep(LETTERS[1:10], 3),
  price_tag = c(rep("high", 10), rep("average", 10), rep("low", 10))
)


ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      pickerInput("mypet", "Select animal type",
        choices = c("cat", "dog", "fish"),
        selected = "fish",
        options = list(
          `actions-box` = TRUE,
          `selected-text-format` = "count > 3"
        ), multiple = T
      ),
      textInput("search", label = "Search table", placeholder = "search"),
      downloadButton("downloadData", "Download your selection")
    ),
    mainPanel(
      dt_output("Raw Data Selection", "table")
    )
  )
)



server <- function(input, output) {
  df_filter <- reactive({
    selected_rows <-
      df %>%
      unite(all, everything()) %>%
      mutate(id = row_number()) %>%
      filter(all %>% str_detect(input$search)) %>%
      pull(id)


    df %>%
      filter(animal %in% input$mypet & row_number() %in% selected_rows)
  })

  output$table <- renderDT({
    datatable(df_filter(), options = list(dom = "t"), filter = list())
  })

  output$downloadData <- downloadHandler(
    filename = function() {
      paste("filtered_data.csv")
    },
    content = function(file) {
      write_csv(df_filter(), file)
    }
  )
}


shinyApp(ui = ui, server = server)