rshinydtflexdashboard
Pagination getting cut off when adding download handler in flexdashboard
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.csv")
})
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"))))
})
```
Solution
After much trail and error, I have found a working solution. I have changed the overload from hidden to auto using a css chunk. This chunk makes the pagination show up when the table overflows the container. ```{css my-style, echo = FALSE}
.chart-wrapper .chart-stage {
overflow: auto;
}
```
Entire test code with addition chunk:
title: "Test"
output:
flexdashboard::flex_dashboard:
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}
output$table1 <- DT::renderDataTable({
datatable(Toys_reactive(),
fillContainer = TRUE,
options = list(dom = 'lfrtip',
lengthMenu = list(c(15,30,45,-1),
c(15,30,45,"All"))))
})
downloadLink('downBtn1', 'Download all data')
output$downloadUI <- renderUI( {
downloadButton("downBtn1", "Example.csv")
})
output$downBtn1 <- downloadHandler(
filename = function() {
"Example.csv"
},
content = function(file) {
write.csv(Toys_reactive()[input[["table1_rows_all"]],], file, row.names = FALSE)
}
)
tabsetPanel(tabPanel("Table1", dataTableOutput("table1")))
```
### Table 2
```{r}
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"))))
})
```
```{css my-style, echo = FALSE}
.chart-wrapper .chart-stage {
overflow: auto;
}
```
If anyone have has a better solution, please include it but I'll be accept this answer within the day.
- Assign groups in dataframe using vectors containing start and end indexes
- Is there a product operator (or work around) in SQLite?
- Loading Magick package after tidyverse
- Make silhouette icons in tmap
- Ignoring NA cases when getting column index of lowest value in row
- plm object to LaTeX table
- Why is my bslib theme not coloring the navbar as expected?
- Adding a footnote to a single row label in a gtsummary table
- How to order a data frame by one descending and one ascending column?
- dplyr is turning dates to doubles when mutating dataframe
- How to display headers from a quarto with a for loop and plotly graphs?
- mixed date converted from default mm/dd/yy in excel to dd/mm/yy
- Git lfs version https://git-lfs.github.com/spec/v1 oid error
- Generate list of lead values
- How to find the date a categorical variable was last active?
- R - could not find function "cld"
- Overlay sf object on ggmap - not aligned, specific to region
- Using ggplot and alleffects in tandem
- Assign categories from JSON column in data table
- Opposite of tidyr::separate, concatenating multiple columns into one
- How to Stack Painted Phylogenetic Trees in R Like ggdensitree but with Colored Regimes
- Counting number of viable pathways in a network diagram from a specific node input
- Report p-value from lme model (random intercept) with gtsummary using tbl_summary() and add_p()
- dynamically remove all nav panel from tabsetPanel
- If x and y have the same length, do qqplot(x,y) and plot(sort(x),sort(y)) yield the same plot in R?
- Applying SPEI::hargreaves function to time series from each pixel of SpatRaster using terra package R?
- Turn dataframe with frequency into a frequency table for chi-square test
- Print result of a function in R
- How to require user authentication in R Shiny before users see any part of the app using shinyauthr?
- Determine foreground / background colour in bslib app with dark/light mode