在 flexdashboard 中添加下载处理程序时分页被中断

Question

我在使用 shiny (downloadHandler) 的下载处理程序和使用 DT（使用 renderDataTable）渲染 table 时遇到问题。当我使用下载处理程序并在我的 flexdashboard 应用程序中呈现 table 时，分页被切断。因此，用户无法切换到 table 的不同页面，因为分页不适合呈现 table 的容器或“框”。只有在我包含 downloadHandler 时才会发生这种情况。如果我使用 DT 的扩展名包含按钮，则分页不会被切断。问题是我需要使用 downloadHandler，因为我的应用程序中的数据量非常大。请注意，示例数据并不代表数据的大小。有谁知道如何解决这个问题？

这是我正在使用的代码：

---
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"))))

})


```

Answer 1

经过多次尝试和错误，我找到了一个可行的解决方案。我使用 css 块将重载从隐藏更改为自动。当 table 溢出容器时，这个块使分页显示出来。 ```{css 我的风格，echo = FALSE}

.chart-wrapper .chart-stage {
    overflow: auto;
}
```

带有附加块的完整测试代码：

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;
}
```

如果有人有更好的解决方案，请包括在内，但我会在一天内接受这个答案。

在 flexdashboard 中添加下载处理程序时分页被中断

Pagination getting cut off when adding download handler in flexdashboard

r

shiny

dt

flexdashboard