R Shiny : Compiling RMarkdown Documents with Download Buttons in Data Table

Question

我正在尝试在 R Shiny 中制作一个响应式(Reactive)数据表，它有一个按钮，您可以按下该按钮来编译 RMarkdown 文档。最终，我试图结合这两个链接的解决方案: R Shiny: Handle Action Buttons in Data Table和 https://shiny.rstudio.com/articles/generating-reports.html .这是我目前所拥有的:

library(shiny)
library(shinyjs)
library(DT)

shinyApp(
  ui <- fluidPage(
    DT::dataTableOutput("data")
  ),

  server <- function(input, output) {

    useShinyjs()

    shinyInput <- function(FUN, len, id, ...) {
      inputs <- character(len)
      for (i in seq_len(len)) {
        inputs[i] <- as.character(FUN(paste0(id, i), ...))
      }
      inputs
    }
    
    df <- reactiveValues(data = data.frame(
  
      Portfolio = c('Column1', 'Column2'),
      Option_1 = shinyInput(downloadButton, 2, 'compile_', label = "Compile Document", onclick = 'Shiny.onInputChange(\"compile_document\",  this.id)' ),
      stringsAsFactors = FALSE,
      row.names = 1:2
    ))


    output$data <- DT::renderDataTable(
      df$data, server = FALSE, escape = FALSE, selection = 'none', filter='top'
    )

    output$compile_document <- downloadHandler(
      filename = "report.html",
      content = function(file) {

        tempReport <- file.path(tempdir(), "report.Rmd")
        file.copy("report.Rmd", tempReport, overwrite = TRUE)

        params <- list(n = input$slider)

        rmarkdown::render(tempReport, output_file = file,
                      params = params,
                      envir = new.env(parent = globalenv())
        )
      }
    )
  }
)

这是我要编译的 RMarkdown 文档:

---
title: "Dynamic 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}
plot(rnorm(params$n), rnorm(params$n))
```

所有的部分似乎都在那里，但我无法将“编译文档”按钮连接到下载处理程序。

Answer 1

这里是一种不使用downloadHandler的方式。

library(shiny)
library(DT)
library(base64enc)
library(rmarkdown)

js <- '
Shiny.addCustomMessageHandler("download", function(b64){
  const a = document.createElement("a");
  document.body.append(a);
  a.download = "report.docx";
  a.href = b64;
  a.click();
  a.remove();
})
'

buttonHTML <- function(i){
  as.character(
    actionButton(
      paste0("button_", i), label = "Report", 
      onclick = sprintf("Shiny.setInputValue('button', %d);", i)           
    )
  )
}

dat <- data.frame(
  PortFolio = c("Column 1", "Column 2")
)
dat$Action <- sapply(1:nrow(dat), buttonHTML)


ui <- fluidPage(
  tags$head(tags$script(HTML(js))),
  br(),
  sliderInput("slider", "Sample size", min = 10, max = 50, value = 20),
  br(),
  DTOutput("dtable")
)


server <- function(input, output, session){
  
  output[["dtable"]] <- renderDT({
    datatable(dat, escape = -ncol(dat)-1)
  })
  
  observeEvent(input[["button"]], {
    showNotification("Creating report...", type = "message")
    tmpReport <- tempfile(fileext = ".Rmd")
    file.copy("report.Rmd", tmpReport)
    outfile <- file.path(tempdir(), "report.html")
    render(tmpReport, output_file = outfile, 
           params = list(
             data = dat[input[["button"]], -ncol(dat)],
             n = input[["slider"]]
           )
    )
    b64 <- dataURI(
      file = outfile, 
      mime = "text/html"
    )
    session$sendCustomMessage("download", b64)
  })
  
}

shinyApp(ui, server)

rmd 文件:

---
title: "Dynamic report"
output: html_document
params:
  data: "x"
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```

Row contents:

```{r}
params$data
```

A plot of `params$n` random points:

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