I am trying to put a progress bar around my shiny downloadHandler(). The progress bar should show the render status of the rmarkdown HTML
I found this infomation on GitHub (https://github.com/rstudio/shiny/issues/1660) but could not get it to work. If I define no environment the file can not be knitted.
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))
```
Your solution was quite close!
Two problems I see with your code:
You've left out the withProgress call in your downloadHandler code
The test for whether you're running in a shiny environment, if (identical(rmarkdown::metadata$runtime, "shiny")), needs to go in your .Rmd file. You enclose any calls to increment/set the progress bar in this test, otherwise the .Rmd code will produce errors like Error in shiny::setProgress(0.5) : 'session' is not a ShinySession object.
The below reworking of your code should work:
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%
```
Another version of answer.
With rmarkdown version 1.14, answer by jsavn seems to not work. Because
rmarkdown::metadata does not have $runtime. (I tried to capture value of rmarkdown::metadata$runtime by saving it as .rds during rendering by rmarkdown::render but it only had value of YAML and metadata$runtime was NULL.
So, for allow setProgress to work with "non-shiny" rendering, pass parameter from shiny-app may be better solution, since this will not depend on values of metadata (which may change as rmarkdown version changes).
app.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)
report.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%
```
Related
This is a follow up question to this How to pass a reactive plot generated in Shiny to Rmarkdown to generate dynamic reports
I am trying to pass the user input in textInput to the filename argument of downloadhandler.
This concept usually works, but in this case this code does not work:
In essence I want to change
filename = "report.html",
TO
filename = paste0("my_new_name", input$text,"-" ,Sys.Date(), ".html"),
Here is the code:
library(shiny)
library(radarchart)
shinyApp(
ui = fluidPage(
sliderInput("slider", "Slider", 1, 100, 50),
textInput("text", "text"),
downloadButton("report", "Generate report")
),
server <- function(input, output) {
output$plot1 <- renderChartJSRadar({
chartJSRadar(skills[, c("Label", input$selectedPeople)],
maxScale = 10, showToolTipLabel=TRUE)
})
output$report <- downloadHandler(
#filename = "report.html",
filename = paste0("my_new_name", input$text,"-" ,Sys.Date(), ".html"),
content = function(file) {
tempReport <- file.path(tempdir(), "report.Rmd")
file.copy("report.Rmd", tempReport, overwrite = TRUE)
params <- list(scores = skills[, c("Label", input$selectedPeople)])
rmarkdown::render(tempReport, output_file = file,
params = params,
envir = new.env(parent = globalenv())
)
}
)
}
)
Report.Rmd
---
title: "Dynamic report"
output: html_document
params:
scores: NA
---
```{r}
chartJSRadar(params$scores, maxScale = 10, showToolTipLabel=TRUE)
```
When the desired file name relies on a reactive value, you have to set it with a function without argument:
filename = function() {
_what_you_want_
}
This is a followup or more a simplification of this question Error: File header.tex not found in resource path in a rmarkdown generated pdf report from a shiny app
With this Rmarkdown code I can achieve what I want:
logo.png
report.Rmd
---
geometry: margin=20truemm
fontfamily: mathpazo
fontsize: 11pt
documentclass: article
classoption: a4paper
urlcolor: blue
output:
pdf_document:
header-includes:
- \usepackage{fancyhdr}
- \pagestyle{fancy}
- \rhead{\includegraphics[width = .05\textwidth]{logo.png}}
params:
scores: NA
---
<!-- ```{r, echo=FALSE} -->
<!-- hist(params$scores) -->
<!-- ``` -->
```{r}
hist(runif(100))
```
Getting desired output: The R logo is in the header:
Now I would like to do the same from a shiny app
For this I pass the plot as a parameter and uncomment the relevant part in the report.Rmd file
relevant part in report.Rmd file:
```{r, echo=FALSE}
hist(params$scores)
```
app.R
# Global variables can go here
n <- 200
# Define the UI
ui <- bootstrapPage(
numericInput('n', 'Number of obs', n),
plotOutput('plot'),
downloadButton('report', 'Generate Report')
)
# Define the server code
server <- function(input, output) {
output$plot <- renderPlot({
hist(runif(input$n))
})
# create markdown report ----------------------------------
output$report <- downloadHandler(
filename = "report.pdf",
content = function(file) {
tempReport <- file.path(tempdir(), "report.Rmd")
file.copy("report.Rmd", tempReport, overwrite = TRUE)
params <- list(scores = input$n)
rmarkdown::render(tempReport, output_file = file,
params = params,
envir = new.env(parent = globalenv())
)
}
)
}
# Return a Shiny app object
shinyApp(ui = ui, server = server)
Error:
! Package pdftex.def Error: File `logo.png' not found: using draft setting.
I suspect because it works locally logo.png is not found in the temporary file where shiny saves tempReport
But I don't know why this works when knitting from markdown and not when calling it from the shiny app.
I think I have been through of the relevant sites on the internet!
Many thanks!
Basically you already figured out what's the issue. Hence one approach to fix your issue would be to do copy both the report template and the logo to the same temporary directory.
# Define the server code
server <- function(input, output) {
output$plot <- renderPlot({
hist(runif(input$n))
})
# create markdown report ----------------------------------
output$report <- downloadHandler(
filename = "report.pdf",
content = function(file) {
td <- tempdir()
tempReport <- file.path(td, "report.Rmd")
tempLogo <- file.path(td, "logo.png")
file.copy("report.Rmd", tempReport, overwrite = TRUE)
file.copy("logo.png", tempLogo, overwrite = TRUE)
params <- list(scores = input$n)
rmarkdown::render(tempReport,
output_file = file,
params = params,
envir = new.env(parent = globalenv())
)
}
)
}
In short I would like to be able to generate a dynamic Rmarkdown report file (pdf or html) from my shiny app with a button click. For this I thought I will use parameterized Report for Shiny. But somehow I can not transfer the single puzzles to the desired aim:
With this code we can generate and download a reactive radarchart in R Shiny:
library(shiny)
library(radarchart)
js <- paste0(c(
"$(document).ready(function(){",
" $('#downloadPlot').on('click', function(){",
" var el = document.getElementById('plot1');",
" // Clone the chart to add a background color.",
" var cloneCanvas = document.createElement('canvas');",
" cloneCanvas.width = el.width;",
" cloneCanvas.height = el.height;",
" var ctx = cloneCanvas.getContext('2d');",
" ctx.fillStyle = '#FFFFFF';",
" ctx.fillRect(0, 0, el.width, el.height);",
" ctx.drawImage(el, 0, 0);",
" // Download.",
" const a = document.createElement('a');",
" document.body.append(a);",
" a.download = 'radarchart.png';",
" a.href = cloneCanvas.toDataURL('image/png');",
" a.click();",
" a.remove();",
" cloneCanvas.remove();",
" });",
"});"
), collapse = "\n")
ui <- pageWithSidebar(
headerPanel('Radarchart Shiny Example'),
sidebarPanel(
checkboxGroupInput('selectedPeople', 'Who to include',
names(radarchart::skills)[-1], selected="Rich"),
actionButton('downloadPlot', 'Download Plot'),
downloadButton('report', 'Generate Report')
),
mainPanel(
tags$head(tags$script(HTML(js))),
chartJSRadarOutput("plot1", width = "450", height = "300"), width = 7
)
)
server <- function(input, output) {
output$plot1 <- renderChartJSRadar({
chartJSRadar(skills[, c("Label", input$selectedPeople)],
maxScale = 10, showToolTipLabel=TRUE)
})
}
shinyApp(ui, server)
What I would like to do is to implement: Generating downloadable reports https://shiny.rstudio.com/articles/generating-reports.html
The code from this site looks like:
app.R
shinyApp(
ui = fluidPage(
sliderInput("slider", "Slider", 1, 100, 50),
downloadButton("report", "Generate report")
),
server = function(input, output) {
output$report <- downloadHandler(
# For PDF output, change this to "report.pdf"
filename = "report.html",
content = function(file) {
# Copy the report file to a temporary directory before processing it, in
# case we don't have write permissions to the current working dir (which
# can happen when deployed).
tempReport <- file.path(tempdir(), "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 (this isolates the code in the document
# from the code in this app).
rmarkdown::render(tempReport, output_file = file,
params = params,
envir = new.env(parent = globalenv())
)
}
)
}
)
report.Rmd
---
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))
```
I have tried a lot like here:
How to pass table and plot in Shiny app as parameters to R Markdown?
Shiny: pass a plot variable to Rmarkdown document when generating a downloadable report
BUT for me it is not possible to transform my code to the provided example code above! The desired output would be something like this after clicking a "Generate Report" button:
Basically your question already included all the building blocks. I only updated the report template to include the code to plot the radar chart. As a parameter I decided to pass the filtered dataset. In the server I only adjusted the specs for the params:
server <- function(input, output) {
output$plot1 <- renderChartJSRadar({
chartJSRadar(skills[, c("Label", input$selectedPeople)],
maxScale = 10, showToolTipLabel=TRUE)
})
output$report <- downloadHandler(
filename = "report.html",
content = function(file) {
tempReport <- file.path(tempdir(), "report.Rmd")
file.copy("report.Rmd", tempReport, overwrite = TRUE)
params <- list(scores = skills[, c("Label", input$selectedPeople)])
rmarkdown::render(tempReport, output_file = file,
params = params,
envir = new.env(parent = globalenv())
)
}
)
}
Report.Rmd
---
title: "Dynamic report"
output: html_document
params:
scores: NA
---
```{r}
chartJSRadar(params$scores, maxScale = 10, showToolTipLabel=TRUE)
```
I want to use data from my shiny app as params in Rmarkdown. How can I get my data and use it. Here is my app:
library(shiny)
library(readxl)
dat2 <-read_xlsx("data/iepp_18.xlsx")
shinyApp(
ui = fluidPage(
selectInput("Ecole","Ecole", as.character(sort(unique(dat2$Nom_Ecole)))),
downloadButton("report", "Generate report")
),
server = function(input, output) {
output$report <- downloadHandler(
filename = "report.html",
content = function(file) {
tempReport <- file.path(tempdir(), "Reports.Rmd")
file.copy("Reports.Rmd", tempReport, overwrite = TRUE)
params <- list(base = input$Ecole)
rmarkdown::render(tempReport, output_file = file,
params = params,
envir = new.env(parent = globalenv())
)
}
)
}
)
And here is my Rmd yaml
title: "Dynamic report"
output: html_document
params:
base: NA
Is it not possible to subset the data in my Rmd with params$base?
``` r
data_bulletin %>%
filter(identification_nom_etablissement==params$base)
```
Is it not possible to subset with params?
Is it possible to use data from my shiny app in Rmarkdown?
I'm basing my code below on this page on R Studio on creating apps with downloadable reports. I've created the following app and .Rmd documents, which are both saved in the same directory:
app.R:
library(rmarkdown)
library(shiny)
shinyApp(
ui = fluidPage(
sliderInput("slider", "Slider", 1, 100, 50),
downloadButton("report", "Generate report")
),
server = function(input, output) {
output$report <- downloadHandler(
filename = "report.pdf",
content = function(file) {
tempReport <- file.path(tempdir(), "report.Rmd")
file.copy("report.Rmd", tempReport, overwrite = TRUE)
params <- list(n = input$slider)
render(tempReport, output_file = file,
params = params,
envir = new.env(parent = globalenv())
)
}
)
}
)
report.Rmd:
---
title: "Dynamic report"
output: pdf_document
params:
n: NA
---
```{r}
# The `params` object is available in the document.
params$n
```
A plot of `r params$n` random points.
```{r}
plot(rnorm(params$n), rnorm(params$n))
```
When I click on the "Generate report" button, the file that gets saved is called "report", when in fact I named it "report.pdf". I end up having to add ".pdf" manually into the filename in order for my computer to recognize it as a PDF document.
Is there a reason why the filename doesn't match exactly what I specified? What else am I supposed to do?
Try to set the the contentType argument of downloadHandler to the correct MIME type, i.e. to "application/pdf".