通过光泽编织文档的进度条

时间:2019-04-02 08:14:54

标签: r shiny r-markdown

我正在尝试在闪亮的downloadHandler()周围放置一个进度条。进度条应显示rmarkdown HTML的呈现状态

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

app.R

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)

report.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))
```

2 个答案:

答案 0 :(得分:2)

您的解决方案非常接近!

我在您的代码中看到两个问题:

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

下面的代码重做应该可以工作:

app.R

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)

report.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%
```

答案 1 :(得分:2)

另一版本的答案。

rmarkdown版本1.14中,jsavn的回答似乎无效。因为  rmarkdown::metadata没有$runtime。 (我尝试通过在rmarkdown::metadata$runtime进行渲染期间将.rds的值保存为rmarkdown::render来捕获metadata$runtime的值,但是它只具有YAML的值,并且NULLsetProgress。 / p>

因此,对于允许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) 使用“非发光”渲染的情况,从闪亮应用传递参数可能是更好的解决方案,因为这将不取决于元数据的值(随rmarkdown版本的更改而变化) )。

app.R

---
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%
```

report.Rmd

Find_Package(LLVM REQUIRED)