I'm having an issue with the download handler from shiny (downloadHandler) and rendering a table using DT (using renderDataTable). When I use the download handler and render the table in my flexdashboard application, the pagination gets cut off. Thus, the user cannot switch to different pages of the table as the pagination doesn't fit the container or "the box" that renders the table. This only happens when I include the downloadHandler. If I include buttons using the extension from DT, the pagination does not get cut off. The problem is that I need to use the downloadHandler as the amount of data in my application is quite large. Please note, the example data is not representative of the size of the data. Does anyone know how to fix this issue?
Here is the code that I'm using:
---
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}
-----------------------------------------------------------------------
```{r}
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
-------------------------------------
```{r}
#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
```{r}
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"))))
})
```
