数据表不会在闪亮应用程序内的 rmarkdown 中呈现

Question

我有一个 Rmarkdown 文件，我想在闪亮的应用程序中显示，还有一个下载按钮来下载它。其中大部分工作正常，但我在 Rmarkdown 文档中有一个DT::datatable。下载并打开后，数据表在 Rmarkdown 中呈现良好，但该表不会显示在闪亮的应用程序本身中。

有没有办法让数据表也显示在应用程序中？我不想使用 kable 等，因为带有数据表的下载和过滤选项非常有用。

Rmarkdown("report.Rmd")：

---
title: "Example report"
output: html_document
params:
  n: NA
---

```{r}
# The `params` object is available in the document.
params$n
```

A plot of `params$n` random points.

```{r plot1}
plot(rnorm(params$n), rnorm(params$n))
```

```{r table1}
DT::datatable(iris, rownames = FALSE, 
                colnames = c("Sepal length", "Sepal width", "Petal length", "Petal width", "Species"), 
                extensions = 'Buttons',
                filter = "none",
                options = list(pageLength = 25, autowidth = TRUE,
                           dom = 'Blftip',                           
                           buttons = c('copy', 'csv', 'excel')))
```

闪亮的应用：

shinyApp(
    ui = fluidPage(
        sidebarLayout(
        sidebarPanel(
        sliderInput("slider", "Slider", 1, 100, 50),
        actionButton("generate_report", "Generate report")
        ),
        mainPanel(uiOutput("report"))
    )),
    server = function(input, output) {
    
        observeEvent(input$slider, {
            output$report <- renderUI(textOutput("holding_text"))
        })
        
        output$holding_text <- renderText("Please select inputs and click 'Generate report'")
        
        observeEvent(input$generate_report, {

            # Copy the report file to a temporary directory before processing it
            my_temp <- tempdir()
            
            tempReport <- file.path(my_temp, "report.Rmd")
            file.copy("report.Rmd", tempReport, overwrite = TRUE)
            
            # Set up parameters to pass to Rmd document
            params <- list(n = input$slider)
            
            # Knit the document, passing in the `params` list, and eval it in a
            # child of the global environment
            rmarkdown::render(tempReport,
                              params = params,
                              envir = new.env(parent = globalenv())
            )
            output$report <- renderUI({
                tagList(
                    downloadButton("download", "Download report"),
                    htmltools::HTML(includeHTML(file.path(my_temp, "report.html")))
                    
                )
            })
            
            output$download <- downloadHandler(
                # For PDF output, change this to "report.pdf"
                filename = "report.html",
                content = function(file) {
                    file.copy(file.path(my_temp, "report.html"), file)
                }
            )
        })
        
    }
)

Answer 1

问题是Shiny在调用includeHTML时不执行JS，DT需要它来渲染表格。

有两种选择：

1. 使用 iframe 标记包含您的文件（此处的详细信息例如：https://stackoverflow.com/a/33021018/17518257），但它有一些缺点（默认高度和宽度并不总是正确计算，滚动问题等）。

2. 直接在 Shiny 中渲染你的 DT，我觉得它更干净。缺点是报告现在分为两部分，数据表和其余部分。以下是操作方法。

首先，将您的 DT 存储在一个变量中，然后再将其显示在 .Rmd 文件中：

```{r table1}
dt_iris <- DT::datatable(iris, rownames = FALSE, 
                colnames = c("Sepal length", "Sepal width", "Petal length", "Petal width", "Species"), 
                extensions = 'Buttons',
                filter = "none",
                options = list(pageLength = 25, autowidth = TRUE,
                           dom = 'Blftip',                           
                           buttons = c('copy', 'csv', 'excel')))
dt_iris
```

然后，在调用 render() 之前为 Markdown 创建渲染环境，以便稍后访问变量 dt_iris：

env <- new.env(parent = globalenv())
rmarkdown::render(tempReport,
                              params = params,
                              envir = env)
dt_iris <- env$dt_iris

最后，用 renderUI() 和 uiOutput() 显示 dt_iris：

ui <- fluidPage(
mainPanel(uiOutput("report"), uiOutput('dt'))

server <- function(input, output) {
output$report <- renderUI({
                tagList(
                    downloadButton("download", "Download report"),
                    htmltools::HTML(includeHTML(file.path(my_temp, "report.html")))
                    
                )
            })
output$dt <- renderUI({
                    htmltools::tagList(dt_iris)
                })
}