Блог

Главная - Вопросы по программированию - Индикатор выполнения для вязания документов с помощью shiny

Индикатор выполнения для вязания документов с помощью shiny

#r #shiny #r-markdown

#r #блестящий #r-уценка

Вопрос:

Я пытаюсь поместить индикатор выполнения вокруг моего shiny downloadHandler(). Индикатор выполнения должен показывать состояние рендеринга rmarkdown HTML

Я нашел эту информацию на GitHub (https://github.com/rstudio/shiny/issues/1660 ) но не смог заставить его работать. Если я не определяю среду, файл не может быть связан.

приложение.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)

отчет.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))
```

Ответ №1:

Ваше решение было довольно близко!

Я вижу две проблемы с вашим кодом:

  • Вы пропустили withProgress вызов в своем downloadHandler коде
  • Проверка того, работаете ли вы в среде shiny, if (identical(rmarkdown::metadata$runtime, "shiny")) должна содержаться в вашем файле .Rmd. Вы включаете любые вызовы для увеличения / установки индикатора выполнения в этом тесте, в противном случае .Rmd-код будет выдавать ошибки типа Error in shiny::setProgress(0.5) : 'session' is not a ShinySession object.

Приведенная ниже переработка вашего кода должна работать:

приложение.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)

отчет.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. rmarkdown::metadata$runtime будет равен только shiny , если это значение задано в заголовке YAML, чтобы указать, что сам документ должен запускаться как приложение Shiny ( shiny.rstudio.com/articles/interactive-docs.html ). Чтобы проверить, выполняется ли Shiny даже в статическом файле R markdown, вы можете использовать shiny::isRunning()

2. Спасибо @HeatherTurner — замена rmarkdown::metadata$runtime на shiny::isRunning() исправила это для меня!

Ответ №2:

Другая версия ответа.

С rmarkdown версией 1.14 ответ от jsavn, похоже, не работает. Потому что rmarkdown::metadata не имеет $runtime . (Я попытался зафиксировать значение rmarkdown::metadata$runtime , сохранив его как .rds во время рендеринга с помощью rmarkdown::render , но оно имело только значение YAML и metadata$runtime было NULL .

Итак, чтобы разрешить setProgress работу с «неблестящим» рендерингом, передача параметра из shiny-app может быть лучшим решением, поскольку это не будет зависеть от значений метаданных (которые могут меняться при изменении версии 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%
```