R + Shiny + DT : 下载过滤后的数据

Question

我正在尝试按照

的方式做一些事情

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

在下面的 reprex 中，如果我 select “鱼”作为动物类型并搜索“high”，我最终得到 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-09-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)

R + Shiny + DT : 下载过滤后的数据

R + Shiny + DT : download filtered data

r

shiny

dt

reactive