通过闪亮编织文件的进度条

Question

我试图在我闪亮的 downloadHandler() 周围放置一个进度条。进度条应该显示 rmarkdown HTML 的渲染状态

我在 GitHub ( https://github.com/rstudio/shiny/issues/1660 )上找到了此信息，但无法使其正常工作。如果我没有定义环境，则无法编织该文件。

应用程序

library(shiny)
library(rmarkdown)

ui <-  fluidPage(
  sliderInput("slider", "Slider", 1, 100, 50),
  downloadButton("report", "Generate report"),
  textOutput("checkrender")
)
server <-  function(input, output, session) {
  output$checkrender <- renderText({
     if (identical(rmarkdown::metadata$runtime, "shiny")) {
       TRUE
     } else {
       FALSE
     }
  })

  output$report <- 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())
      )
    }
  )
}

shinyApp(ui = ui, server = server)

报告.Rmd

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

```{r}
params$n
```

A plot of `params$n` random points.

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

Answer 1

另一个版本的答案。

在rmarkdown1.14 版本中，jsavn 的回答似乎不起作用。因为 rmarkdown::metadata没有$runtime。（我试图rmarkdown::metadata$runtime通过将其保存为.rds渲染期间来捕获 的值rmarkdown::render，但它只有 YAML 的值并且metadata$runtime是NULL.

因此，为了允许setProgress使用“非闪亮”渲染，从闪亮应用程序传递参数可能是更好的解决方案，因为这不依赖于元数据的值（元数据可能会随着 rmarkdown 版本的变化而变化）。

应用程序R

library(shiny)
library(rmarkdown)

ui <-  fluidPage(
  sliderInput("slider", "Slider", 1, 100, 50),
  downloadButton("report", "Generate report")
)
server <-  function(input, output, session) {

  output$report <- downloadHandler(
    filename = "report.html",
    content = function(file) {
      withProgress(message = 'Rendering, please wait!', {
        tempReport <- file.path(tempdir(), "report.Rmd")
        file.copy("report.Rmd", tempReport, overwrite = TRUE)

        params <- list(n = input$slider,
                       rendered_by_shiny = TRUE)

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

shinyApp(ui = ui, server = server)

报告.Rmd

---
title: "Dynamic report"
output: html_document
params:
  n: 10
  rendered_by_shiny: FALSE
---

```{r}
params$n

if (params$rendered_by_shiny)
  shiny::setProgress(0.5)  # set progress to 50%
```

A plot of `params$n` random points.

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

if (params$rendered_by_shiny)
  shiny::setProgress(1)  # set progress to 100%
```

Answer 2

您的解决方案非常接近！

我看到你的代码有两个问题：

• 您withProgress在downloadHandler代码中遗漏了调用
• 测试您是否在闪亮的环境中运行if (identical(rmarkdown::metadata$runtime, "shiny"))，需要在您的 .Rmd 文件中进行。您在此测试中包含任何用于增加/设置进度条的调用，否则 .Rmd 代码将产生类似错误Error in shiny::setProgress(0.5) : 'session' is not a ShinySession object.

您的代码的以下返工应该有效：

应用程序

library(shiny)
library(rmarkdown)

ui <-  fluidPage(
  sliderInput("slider", "Slider", 1, 100, 50),
  downloadButton("report", "Generate report"),
  textOutput("checkrender")
)
server <-  function(input, output, session) {
  output$checkrender <- renderText({
    if (identical(rmarkdown::metadata$runtime, "shiny")) {
      TRUE
    } else {
      FALSE
    }
  })

  output$report <- downloadHandler(
    filename = "report.html",
    content = function(file) {
      withProgress(message = 'Rendering, please wait!', {
        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())
        )
      })
    }
  )
}

shinyApp(ui = ui, server = server)

报告.Rmd

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

```{r}
params$n

if (identical(rmarkdown::metadata$runtime, "shiny"))
  shiny::setProgress(0.5)  # set progress to 50%
```

A plot of `params$n` random points.

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

if (identical(rmarkdown::metadata$runtime, "shiny"))
  shiny::setProgress(1)  # set progress to 100%
```