I want to upload images and text in shiny web (not inset image in code) , and then download as PDF document.
I am get stuck in download images into PDF document.
In "output$report <- downloadHandler(...)", params cannot be "observe" or "output$image". How to write the right params for the images?
library(shiny)
ui<-navbarPage("Report",
tabPanel("Upload Images", uiOutput('page1')),
tabPanel("Input Text", uiOutput('page2')),
tabPanel("Download Report", uiOutput('page3'))
)
server <- function(input, output, session) {
output$page1 <- renderUI({
fluidPage(
fluidRow(
column(5,
fileInput(inputId = 'files',
label = 'Select 1st Image',
multiple = TRUE,
accept=c('image/png', 'image/jpeg'),
width = '400px')
))) })
output$page2 <- renderUI({
fluidPage(
fluidRow(
column(8,
textInput("Text1", "(1)", " ",width = '600px')
#verbatimTextOutput("Value1")
),
column(4, uiOutput('Image1'))
))
})
files <- reactive({
files <- input$files
files$datapath <- gsub("\\\\", "/", files$datapath)
files
})
output$Image1 <- renderUI({
if(is.null(input$files)) return(NULL)
image_output_list <-
lapply(1:nrow(files()),
function(i)
{
imagename = paste0("image", i)
imageOutput(imagename)
})
do.call(tagList, image_output_list)
})
IMAGE1 <- observe({
if(is.null(input$files)) return(NULL)
for (i in 1:nrow(files()))
{
print(i)
local({
my_i <- i
imagename = paste0("image", my_i)
print(imagename)
output[[imagename]] <-
renderImage({
list(src = files()$datapath[my_i],
width = 250,
height = 250,
alt = "Image failed to render")
}, deleteFile = FALSE)
})
}
}) ######!!!! Parms cannot be observe or output$Image1
output$page3 <- renderUI({ downloadButton("report", "Generate report")})
output$report <- downloadHandler(
filename = "report.pdf",
content = function(file) {
tempReport <- file.path(tempdir(), "VIWpdf.Rmd")
file.copy("VIWpdf.Rmd", tempReport, overwrite = TRUE)
params <- list(
Text1 = input$Text1,
Image1 = IMAGE1 ######!!!!!Here this the Problem######
)
out<- rmarkdown::render(tempReport, output_file = file,
params = params,
envir = new.env(parent = globalenv()))
file.rename(out, file)
}
)}
shinyApp(ui=ui,server=server)
Here is the .rmd
---
title: "Report"
date: "`r format(Sys.time(), '%d %B, %Y')`"
always_allow_html: yes
output:
pdf_document:
fig_caption: yes
keep_tex: yes
toc: true
toc_depth: 2
params:
Text1: 'NULL'
Image1: 'NULL'
---
(1) `r params$Text1`
`r params$Image1`
I expect the output of image can show in the Rmarkdown PDF, but the actual output is empty.
Your renderImage statements work by parsing the paths to the images. Similarly, you need to pass the paths to the images to params when rendering the Rmd. You also want the images copied to the tempdir. And finally, in the Rmd, you need evaluate the params$Image inline as you are linking to the image files.
Here are the required changes:
The Rmd should read something like this. Note that we are pasting the value of params$Image1 when linking to the image file r paste0(params$Image1)
---
title: "Report"
date: "`r format(Sys.time(), '%d %B, %Y')`"
always_allow_html: yes
output:
pdf_document:
fig_caption: yes
keep_tex: yes
toc: true
toc_depth: 2
params:
Text1: 'NULL'
Image1: 'NULL'
---
```{r}
message("this is the text passed as a parameter")
message(params$Text1)
## Omitting one tick mark to render 'correctly' in SO answer
``
Here is the image
![Some image](`r paste0(params$Image1)`)
Next, inside downloadHandler we work with input$files rather than IMAGE1 (observers don't return values) because all we need are the paths to the selected images. Also, we need to copy the images to the same tempdir where the Rmd gets rendered. The download handler should look like this (heads up, I changed the name of the Rmd):
output$report <- downloadHandler(
filename = "report.pdf",
content = function(file) {
tempReport <- file.path(tempdir(), "image.rmd")
file.copy("image.rmd", tempReport, overwrite = TRUE)
# copy the image to the tempdir
# otherwise `render` will not know where it is
imgOne <- file.path(tempdir(), input$files[[1]])
file.copy(input$files[[1]], imgOne, overwrite = TRUE)
params <- list(Text1 = input$Text1,
# pass the path to the image in the tempdir
Image1 = imgOne)
out <- rmarkdown::render(
tempReport,
output_file = file,
params = params,
envir = new.env(parent = globalenv())
)
file.rename(out, file)
}
)
In downloadHandler you would need to loop over the list of images to copy to tempdir and add an element to the params list. In the Rmd you would need to loop over params$Image* to create the links to all the images.
Complete app that worked for me with 1 image only:
library(shiny)
ui <- navbarPage(
"Report",
tabPanel("Upload Images", uiOutput('page1')),
tabPanel("Input Text", uiOutput('page2')),
tabPanel("Download Report", uiOutput('page3'))
)
server <- function(input, output, session) {
output$page1 <- renderUI({
fluidPage(fluidRow(column(
5,
fileInput(
inputId = 'files',
label = 'Select 1st Image',
multiple = TRUE,
accept = c('image/png', 'image/jpeg'),
width = '400px'
)
)))
})
output$page2 <- renderUI({
fluidPage(fluidRow(column(
8,
textInput("Text1", "(1)", " ", width = '600px')
#verbatimTextOutput("Value1")
),
column(4, uiOutput('Image1'))))
})
files <- reactive({
files <- input$files
files$datapath <- gsub("\\\\", "/", files$datapath)
files
})
output$Image1 <- renderUI({
if (is.null(input$files))
return(NULL)
image_output_list <-
lapply(1:nrow(files()),
function(i)
{
imagename = paste0("image", i)
imageOutput(imagename)
})
do.call(tagList, image_output_list)
})
observe({
if (is.null(input$files))
return(NULL)
for (i in 1:nrow(files()))
{
print(i)
print(input$files[[i]])
local({
my_i <- i
imagename = paste0("image", my_i)
print(imagename)
output[[imagename]] <-
renderImage({
list(
src = files()$datapath[my_i],
width = 250,
height = 250,
alt = "Image failed to render"
)
}, deleteFile = FALSE)
})
}
}) ######!!!! Parms cannot be observe or output$Image1
output$page3 <-
renderUI({
downloadButton("report", "Generate report")
})
output$report <- downloadHandler(
filename = "report.pdf",
content = function(file) {
tempReport <- file.path(tempdir(), "image.rmd")
file.copy("image.rmd", tempReport, overwrite = TRUE)
imgOne <- file.path(tempdir(), input$files[[1]])
file.copy(input$files[[1]], imgOne, overwrite = TRUE)
params <- list(Text1 = input$Text1,
Image1 = imgOne) ######!!!!!Here this the Problem######
out <- rmarkdown::render(
tempReport,
output_file = file,
params = params,
envir = new.env(parent = globalenv())
)
file.rename(out, file)
}
)
}
shinyApp(ui = ui, server = server)
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_
}
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'm trying to make a reactive data table in R Shiny that has a button you can press to compile an RMarkdown document. Ultimately, I'm trying to combine the solutions from these two links:
R Shiny: Handle Action Buttons in Data Table and https://shiny.rstudio.com/articles/generating-reports.html. Here is what I have so far:
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())
)
}
)
}
)
Here is the RMarkdown document I'd like to compile:
---
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))
```
The pieces all seem to be there, but I can't connect the "Compile Document" button to the download handler.
Here is a way that does not use 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)
The rmd file:
---
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))
```
I have a shiny app. The app contains a table. Each row in the table contains one button that should allow a user to download the data from that row into a report.
I am simply stuck on being able to hook the custom row button to the download handler. Normally I'd use the download button to do this but how can I do it with a custom button.
My observe event:
observeEvent(input$lastClick,
{
if (input$lastClickId%like%"letter")
{
row_to_report=as.numeric(gsub("letter_","",input$lastClickId))
MyLetter=RV4$data[row_to_report,]
How do I trigger the download here using the downloadHandler:
downloadHandler(
filename = "letter.docx",
content = function(file) {
tempReport <- file.path(tempdir(), "letter.Rmd")
file.copy("letter.Rmd", tempReport, overwrite = TRUE)
# Set up parameters to pass to Rmd document
params <- list(MyLetter)
rmarkdown::render(tempReport, output_file = file,
params = params,
envir = new.env(parent = globalenv()),
)
}
)
}
else if (input$lastClickId%like%"delete")
{
row_to_del=as.numeric(gsub("delete_","",input$lastClickId))
RV3$data=RV3$data[-row_to_del,]
}
}
)
My datatable is created like this:
output$drilldownBarr <- DT::renderDT({
if (!is.null(drilldataBarrd())) {
browser()
drilldataBarrdf<-drilldataBarrd()
drilldataBarrdf$Actions<-
paste0('
<div class="btn-group" role="group" aria-label="Basic example">
<button type="button" class="btn btn-secondary letter" id=letter_',1:nrow(drilldataBarrd()),'>Letter</button>
</div>
')
}
datatable(drilldataBarrdf,escape=F, extensions = c("Select","Buttons"), selection = "none",
options = list(
scrollX = TRUE,
scrollY = TRUE,
pageLength = 200,
select = "api",
dom = 'Bfrtip',
buttons = c('copy', 'csv', 'excel', 'pdf', 'print','colvis'))
)
})
Perhaps there is a better way? For example creating a download button in each row. But how to do this?
Here is a solution using base64 encoding of the report file. It does not use 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 <- iris[1:5,]
dat$Action <- sapply(1:nrow(dat), buttonHTML)
ui <- fluidPage(
tags$head(tags$script(HTML(js))),
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.docx")
render(tmpReport, output_file = outfile,
params = list(data = dat[input[["button"]], -ncol(dat)]))
b64 <- dataURI(
file = outfile,
mime = "application/vnd.openxmlformats-officedocument.wordprocessingml.document"
)
session$sendCustomMessage("download", b64)
})
}
shinyApp(ui, server)
The rmarkdown file report.Rmd:
---
title: "Untitled"
author: "Stéphane Laurent"
date: "16 avril 2020"
output: word_document
params:
data: "x"
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```
```{r}
params$data
```
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%
```