How to use Downhandler from shiny to download results from the search in table that is rendered in the application?

Hello,

I'm trying to use the downhandler to download the results from the table that is rendered using DT::renderDataTable(). Currently, the download handler downloads all the data displayed in the table. I want the file downloaded to include only the data that they filtered using the search box. Does anyone know how I can do this using flexdashboard?

Here is the code:


---
title: "Test"
output: 
  flexdashboard::flex_dashboard:
  orientation: rows
  vertical_layout: fill

runtime: shiny
---

```{r global, include=FALSE}
library(dplyr)
library(tidyquant)
library(ggplot2)
library(stringr)
library(tidyr)
library(pins)
library(shiny)
library(httr)
library(XML)
library(DT)
library(plotly)
library(purrr)


test_data  <- structure(list(Toys = c("Slinky", "Slinky", "Slinky", "Slinky", 
"Slinky", "Slinky", "Tin Solider", "Tin Solider", "Tin Solider", 
"Tin Solider", "Tin Solider", "Tin Solider", "Hungry Hungry Hippo", 
"Hungry Hungry Hippo", "Hungry Hungry Hippo", "Hungry Hungry Hippo", 
"Hungry Hungry Hippo", "Hungry Hungry Hippo"), Manufacturer = c("Manufacturer A", 
"Manufacturer B", "Manufacturer C", "Manufacturer A", "Manufacturer A", 
"Manufacturer A", "Manufacturer B", "Manufacturer B", "Manufacturer B", 
"Manufacturer B", "Manufacturer B", "Manufacturer B", "Manufacturer C", 
"Manufacturer C", "Manufacturer C", "Manufacturer C", "Manufacturer C", 
"Manufacturer C"), Price = c(5.99, 6.99, 7.99, 9, 6, 5.54, 7, 
9.99, 6.99, 6.75, 8, 7.99, 9.99, 7.99, 5.99, 8.99, 10.99, 9.75
), change = c(0, 16.69449082, 14.30615165, 12.640801, -33.33333333, 
-7.666666667, 0, 42.71428571, -30.03003003, -3.433476395, 18.51851852, 
-0.125, 0, -20.02002002, -25.03128911, 50.08347245, 22.24694105, 
-11.28298453), Dates = c("1/1/2021", "3/1/2021", "5/1/2021", 
"7/1/2021", "9/1/2021", "10/1/2021", "1/1/2021", "3/1/2021", 
"5/1/2021", "7/1/2021", "9/1/2021", "10/1/2021", "1/1/2021", 
"3/1/2021", "5/1/2021", "7/1/2021", "9/1/2021", "10/1/2021")), class = "data.frame", row.names = c(NA, 
-18L))
names(test_data) <- c("Toys", "Manufacturer", "Price", "change", "Dates")
 Sidebar {.sidebar}
 -----------------------------------------------------------------------

selectInput("Toys",
            label = "Toys",
            choices = unique(sort(test_data$Toys)),
            selected = "Slinky")


selectizeInput("Manufacturer",
            label = "Manufacturer",
            choices = c("Select All",as.character(unlist(test_data %>%
                        dplyr::select(Manufacturer) %>%
                        dplyr::arrange(Manufacturer) %>%
                        distinct()))), 
            multiple = TRUE,
            options = list(placeholder = 'Make a selection below'))               
Column 
 -------------------------------------
#Hides initial error messages
tags$style(type="text/css",
  ".shiny-output-error { visibility: hidden; }",
  ".shiny-output-error:before { visibility: hidden; }"
)


observe({
if (!is.null(input$Toys)){
  updateSelectInput(
    inputId = "Manufacturer",
    choices =c("Select All", test_data %>%
      dplyr::filter(Toys == input$Toys) %>%
      dplyr::select(Manufacturer) %>%
      dplyr::distinct() %>%
      dplyr::pull(Manufacturer) %>%
      str_sort),
    selected = test_data %>%
      dplyr::filter(Toys == input$Toys) %>%
      dplyr::select(Manufacturer) %>%
      dplyr::distinct() %>% slice_head()
    )
  }
})

observe ({
  if("Select All" %in% input$Manufacturer){
    updateSelectInput(
      inputId = "Manufacturer", 
    selected = test_data %>%
      dplyr::filter(Toys == input$Toys) %>%
      dplyr::select(Manufacturer) %>%
      dplyr::distinct() %>%
      dplyr::pull(Manufacturer) %>%
      str_sort 
    )
  }
})

Toys_reactive <- reactive({
  if(length(unique(test_data$Manufacturer)) >= 1){
    Toys_reactive = NULL
    for(i in input$Manufacturer){
      subset_toys <- test_data %>% 
        dplyr::filter(Manufacturer == i & Toys == input$Toys)
      Toys_reactive <- rbind(Toys_reactive, subset_toys)
    }
  }
  Toys_reactive
})

    
 {.tabset .tabset-fade}
 -------------------------------------

 ### Table 1

downloadLink('downBtn1', 'Download all data')
output$downloadUI <- renderUI( {
  downloadButton("downBtn1", "Example.csvv")
})

output$downBtn1 <- downloadHandler(
  filename = function() {
    "Example.csv"
  },
  content = function(file) {
    write.csv(Toys_reactive(), file, row.names = FALSE)
  }
)


DT::renderDataTable({
datatable(Toys_reactive(),
          fillContainer = TRUE, 
          options = list(dom = 'lfrtip',
                           lengthMenu = list(c(15,30,45,-1),
                                             c(15,30,45,"All"))))

})


  ### Table 2

downloadLink('downBtn', 'Download all data')
output$downloadUI <- renderUI( {
  downloadButton("downBtn", "Example.csvv")
})

output$downBtn <- downloadHandler(
  filename = function() {
    "Example.csv"
  },
  content = function(file) {
    write.csv(Toys_reactive(), file, row.names = FALSE)
  }
)


DT::renderDataTable({
datatable(Toys_reactive(),
          fillContainer = TRUE, 
          options = list(dom = 'lfrtip',
                           lengthMenu = list(c(15,30,45,-1),
                                             c(15,30,45,"All"))))

})

This topic was automatically closed 21 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.