How to display R Shiny output in R Markdown? - r

I'm new to R markdown here and I am trying to create an R Shiny app which I can enter a list of names, and then download the output (like a name list) as HTML file. I am using R markdown to create the HTML file. Here are my sample codes:
R Shiny:
library(shiny)
ui <- list(
textInput("name", "Type new text input name", value = ""),
actionButton("btn", "click me to create text input"),
uiOutput("newInputs"),
downloadButton("download_report", "Download")
)
server <- function(input, output)
{
family_member <- reactiveValues(
add_family_info = list()
)
observeEvent(input$btn, {
newid <- paste(length(family_member$add_family_info))
family_member$add_family_info <- c(family_member$add_family_info, list(c(newid, input$name)))
family_member
})
output$newInputs <- renderUI({
lapply(family_member$add_family_info, function(a)
c(paste(a[2])))
})
output$download_report <- downloadHandler(
filename = "name.html",
content = function(file) {
tempReport <- file.path(tempdir(), "name.Rmd")
file.copy("name.Rmd", tempReport, overwrite = TRUE)
params <- list(report = uiOutput("newInputs"))
rmarkdown::render(tempReport, output_file = file,
params = params,
envir = new.env(parent = globalenv()))
}
)
}
runApp(list(ui = ui, server = server))
R Markdown:
---
runtime: shiny
output: html_document
params:
report: NA
---
\
\
# Member names
`r params$report`
Appreciate any help! Thanks in advance!!!!

If you are just using a Shiny to render an Rmarkdown document, you don't need the runtime of the document to be Shiny. This is only needed if the document itself will ultimately be a shiny app.
Looking at the download handler
params <- list(report = uiOutput("newInputs"))
The uiOutput function generates the html for the element. It doesn't retrieve the values (you can see this if you run execute it in the console by itself). Additionally newInputs just refers to the container for the text (it's not actually inputs). Instead, you would want to use the reactive value storing the list
params <- list(report = family_member$add_family_info)
However, since this will be printed it can't be an arbitrary R object. It has to be something that cat can handle. In this case family_member$add_family_info is a list of list. Try flattening it with something like
params <- list(report = unlist(family_member$add_family_info))

Related

Get correct input value to display in download file name with rmarkdown word doc from downloadHandler in Shiny App

I have built a Shiny app and my client wants to be able to download some of its content to a Word document. Using the steps laid out here (with a correction to the sample code per this post), I have a working download button. Instead of a generic default file name like "report.docx", I want to generate a standard file name that includes the name of the subject of the report, as selected from an input value selection from a dropdown list in the UI of the Shiny app. This seems like it should be pretty easy, and I get very close: I can get the file name to include the default value for that input selection, but I can't get it to update correctly when the user makes a new selection.
The following code is a simplified example of what I want and generates the issue I am experiencing:
Data:
cities <- c("Atlanta", "Boston", "Chicago", "Detroit")
values <- c(100, 200, 300, 400)
test_df <- cbind.data.frame(cities, values)
saveRDS(test_df, file = "C:/Repos/Test Report Name/app/test_df.rds")
UI:
library(shinydashboard)
library(shinyjs)
library(shinycssloaders)
library(shinyWidgets)
library(reactable)
ui <- fluidPage(
mainPanel(
fluidRow(
selectInput('test',
label = 'Test',
choices = sort(unique(test_df$cities)),
multiple = FALSE,
selected = sort(unique(test_df$cities))[1])
),
fluidRow(
reactableOutput("data")
),
fluidRow(
downloadButton("report", "Generate Report")
)
)
)
Server:
library(tidyverse)
library(reactable)
library(shinyWidgets)
server <- function(input, output) {
output$data <- renderReactable({
x <- test_df %>%
dplyr::filter(cities %in% input$test)
reactable(x)
})
output$report <- downloadHandler(
# For PDF output, change this to "report.pdf"
filename = paste(input$test, "Summary", Sys.Date(), ".docx"), ### This paste function is the crucial part; I get the default value (Atlanta) no matter which option I select.
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(selection = input$test)
# 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).
output <- rmarkdown::render(input = tempReport,
params = params,
envir = new.env(parent = globalenv())
)
file.copy(output, file)
}
)
}
Markdown file:
---
title: "`r params$selection` Report"
output: word_document
params:
selection: NA
---
```{r}
library(tidyverse)
x <- test_df %>%
filter(cities %in% params$selection)
print(x)
```
So, I run this, and everything works, except for the file name. I select Boston in the dropdown, and I get markdown file with Boston in the title and Boston data in the table, but the file is still called "Atlanta Summary 1-3-2023.docx". I have tried creating new variables in the server file that just take the input$test value, such as below:
print_input_name <- reactive({
x <- input$test
x
})
## Error in as.vector: cannot coerce type 'closure' to vector of type 'character'
print_input_name <- eventReactive({
x <- input$test
x
})
## Error in is_quosure(expr) : argument "expr" is missing, with no default
I tried wrapping all that downloadHandler() statement in observeEvent(input$test, {...}) but that didn't work either. I also tried just naming the object after the input directly (x <- input$test) and naming the object output$x, but that didn't work either. Also trying calling it params$selection like it is in the RMD file but that obviously didn't work. So I'm stumped about how to get that input selection to be stored as an object in the server that I can reference. Any help appreciated, I am pretty new to Shiny and am still learning the ins and outs of reactive elements.
According to the docs (?downloadHandler) the filename argument should be
A string of the filename, [...]; or a function that returns such a string. (Reactive values and functions may be used from this function.)
Hence to fix your issue use
filename = function() paste(input$test, "Summary", Sys.Date(), ".docx")
See also the examples section of the docs.
Complete reproducible code:
cities <- c("Atlanta", "Boston", "Chicago", "Detroit")
values <- c(100, 200, 300, 400)
test_df <- data.frame(cities, values)
library(shiny)
library(reactable)
library(tidyverse)
ui <- fluidPage(
mainPanel(
fluidRow(
selectInput("test",
label = "Test",
choices = sort(unique(test_df$cities)),
multiple = FALSE,
selected = sort(unique(test_df$cities))[1]
)
),
fluidRow(
reactableOutput("data")
),
fluidRow(
downloadButton("report", "Generate Report")
)
)
)
server <- function(input, output) {
output$data <- renderReactable({
x <- test_df %>%
dplyr::filter(cities %in% input$test)
reactable(x)
})
output$report <- downloadHandler(
filename = function() paste(input$test, "Summary", Sys.Date(), ".docx"),
content = function(file) {
tempReport <- file.path(tempdir(), "report.Rmd")
file.copy("report.Rmd", tempReport, overwrite = TRUE)
params <- list(selection = input$test)
output <- rmarkdown::render(
input = tempReport,
params = params,
envir = new.env(parent = globalenv())
)
file.copy(output, file)
}
)
}
shinyApp(ui, server)
#>
#> Listening on http://127.0.0.1:3354

Dynamically upload files in a Shiny app and pass their path as a parameter to a Rmarkdown file

I want to build an R shiny app that has a dynamic input that asks the user for a numeric input (the number of scenarios) and then based on that input generates text input and file input controls. Here is what I have in mind.
For each scenario, the user provides a name and a data file (.csv for example). I would like to pass the provided information to a Rmarkdown file where some analysis is done and eventually a report is generated (by clicking on the "Generate report" in the picture above.)
Here is the server/ui code:
library(shiny)
server <- function(input, output) {
output$input_ui <- renderUI({
num <- as.integer(input$num)
lapply(1:num, function(i) {
textInput(paste0("sc_name", i), label = paste0("Enter the name of Scenario ",i),
value = "", width = NULL, placeholder = NULL)
})
})
output$input_file_ui <- renderUI({
num <- as.integer(input$num)
lapply(1:num, function(i) {
fileInput(paste0("infile ", i), paste0("Choose Scenario File ", i),
multiple = FALSE,
accept = c("text/csv", ".xlsx",
"text/comma-separated-values,text/plain",
".csv"))
})
})
output$report <- downloadHandler(
filename = "report.html",
content = function(f) {
tempReport <- file.path(tempdir(), "report_generator.Rmd")
file.copy("report_generator.Rmd", tempReport, overwrite = TRUE)
# Set up parameters to pass to Rmd document
num <- as.integer(input$num)
names <- sapply(1:num, function(i) {
input[[paste0("sc_name", i)]]
})
paths_list <- lapply(1:num, function(i){
input[[paste0("infile", i)]][["datapath"]]
})
params <- list(scenario_names = names,
data_paths = paths_list)
rmarkdown::render(tempReport, output_file = f,
params = params,
envir = new.env(parent = globalenv())
)
}
)
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("num", "Select the number of scenarios", choices = seq(1,10,1)),
uiOutput("input_ui"),
uiOutput("input_file_ui")
),
mainPanel(
downloadButton("report", "Generate report")
)
)
)
shinyApp(ui = ui, server = server)
What I am trying to pass as parameters to the Rmarkdown file are
a list of the scenario names (collected from the text input controls)
a list of scenario data files' "datapath". The Rmarkdown file will read the data using the provided datapath (via read.csv() for example).
Here is a very simple Rmarkdown report_generator.Rmd file (where I only try to print the list of scenario names and paths)
---
title: "Report Generator"
output: html_document
params:
data_paths: NULL
scenario_names: NULL
---
```{r}
params$data_paths
```
```{r}
params$scenario_names
```
While the code generates the list of scenario names and pass it to the Rmarkdown file without any problem, there seem to be some problems with the list of "datapath"s. It is shown as NULL in the final report.
My question are how can I modify the code to dynamically input the files (in case my way of doing it is not optimal), and how can I pass a list of their datapath as a parameter to the Rmarkdown file.

Inline code not executed in a shiny app with Rmarkdown report

Dear all shiny developers!
I have a question about a shiny app with a Rmarkdown report downloadable.
The app is based on this https://shiny.rstudio.com/articles/generating-reports.html, taken here as an exemple.
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.pdf",
content = function(filename) {
# 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(), "Template.Rmd")
print(tempReport)
file.copy("Template.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 = filename,
params = params,
envir = new.env(parent = globalenv())
)
}
)
}
)
with my .Rmd document
---
title: ''
output: pdf_document
geometry: "left=2cm,right=2cm,top=1cm,bottom=2cm"
params:
n: NA
---
```{r}
# The `params` object is available in the document.
params$n
```
A plot of `r params$n` random points.
The code is running ok, the document is created but when I open it, I can see that the code within the chunk is ok but not in the inline code, see below:
However, in this exemple https://shiny.rstudio.com/gallery/download-knitr-reports.html we see that the inline code is good (I don't have the code of the Rmarkdown unfortunatelly).
I saw this subject (https://community.rstudio.com/t/embedding-shiny-with-inline-not-rendering-with-html-output/41175) that could be similar but it is html and the answer does not seem to fit.
Do you have an idea why it does not function ? Or any track to explore ?
Many thanks !!
Be careful to the file.copy function !
Thanks to the remark of Limey, I notice that the Rmarkdown that had a typo few moments ago was not updated! Careful that the file.copy is correct!
Here is the script working:
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.pdf",
content = function(filename) {
# 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(), "rules.Rmd")
print(tempReport)
file.copy("Data/rules.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 = filename,
params = params,
envir = new.env(parent = globalenv())
)
}
)
}
)
and the Rmarkown
---
title: ''
output: pdf_document
geometry: "left=2cm,right=2cm,top=1cm,bottom=2cm"
params:
n: NA
---
```{r}
# The `params` object is available in the document.
params$n
```
A plot of `r params$n` random points.
Thanks to all of you that gave time to this subject!

Rendering word document through shiny app, odd behaviour

I can't make the production of my word report use my template. The report gets generated but not with my styling.
I saw similar threads here and here but nothing i saw there resolved my issues.
The second problem i have (see example below) is that no matter which country is selected, the report always takes the name of the first country in the list (while it shouldn't be the case, the name should respond to the country input).
library(shiny)
ui <- fluidPage(
'Please select a country from the list below: ',
selectInput(
'Country',
'Country',
c('Albania','Belgium','Romania'),
selected = NULL,
multiple = FALSE,
selectize = TRUE,
width = NULL,
size = NULL
),
downloadButton("report", "Generate report")
)
server <- function(input, output,session) {
##### Report generation #####
output$report <- downloadHandler(
# For PDF output, change this to "report.pdf"
filename = paste0(input$Country,'_',Sys.Date(),".docx"),
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(Country = input$Country)
# 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())
)
}
)
}
# Run the application
shinyApp(ui = ui, server = server)
And the report.Rmd
---
title: "Title"
output: word_document
reference_docx: Template.docx
params:
Country: NA,
---
# `r params$Country`
`r Sys.Date()`

Attach a knitted tempfile to email in R shiny

I have a working shiny app that uses Mailgun to send an email when a button is clicked and also produces a rmarkdown report when another button is clicked.
Here is working code, obviously without the working email authentication:
ui.R
library(shiny)
# Define UI for application that draws a histogram
shinyUI(fluidPage(
sliderInput("slider", "Slider", 1, 100, 50),
downloadButton("report", "Generate report"),
actionButton("mail", "send email"),
textOutput('mailo')
)
)
server.R
library(shiny)
sendEmail <- function(email = "xxx#you.org",
mail_message = "Hello"){
url <- "https://api.mailgun.net/v3/sandboxxxxxxxxx.mailgun.org/messages"
## username:password so api_key is all after the api:
api_key <- "key-0xxxxxxxxxxxx"
the_body <-
list(
from="Mailgun Sandbox <postmaster#sandboxxxxxxxxxxxxxxxx.mailgun.org>",
to=email,
subject="Mailgun from R test",
text=mail_message
)
req <- httr::POST(url,
httr::authenticate("api", api_key),
encode = "form",
body = the_body)
httr::stop_for_status(req)
TRUE
}
# Define server logic required to draw a histogram
shinyServer(function(input, output) {
event <- observeEvent(input$mail,{
sendEmail()
}, ignoreInit = TRUE)
output$mailo <- renderText({print("EMAIL SENT!")})
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())
)
}
)
})
I want to do both things in one step. That is, generate the report, attach it to the email and send it to the given address. I am just not sure how to treat a tempfile() when referencing the file.
I also currently have the app deployed on Shinyapps.io, so saving to file and then retrieving won't work.
Any ideas?
This is the code you need. I tested this and it worked, although my gmail did give me huge bright yellow warnings that the email contains an unverified file that may be dangerous. I also simplified the app a bit and removed some unnecessary code.
library(shiny)
ui <- fluidPage(
sliderInput("slider", "Slider", 1, 100, 50),
actionButton("mail", "send email")
)
sendEmail <- function(email = "RECIPIENT#gmail.com",
mail_message = "Hello",
file = NULL) {
url <- "https://api.mailgun.net/v3/sandboxxxxxxxxxxxxxxxxxxxxxxxx.mailgun.org/messages"
## username:password so api_key is all after the api:
api_key <- "XXXXXXXXXXXXXXXXXX-XXXXXXXXX-XXXXX"
the_body <-
list(
from = "Mailgun Sandbox <postmaster#sandboxXXXXXXXXXXXXXXXXXXX.mailgun.org>",
to = email,
subject = "Mailgun from R test",
text = mail_message
)
if (!is.null(file)) {
the_body$attachment = httr::upload_file(file)
}
req <- httr::POST(url,
httr::authenticate("api", api_key),
encode = "multipart",
body = the_body)
httr::stop_for_status(req)
TRUE
}
server <- function(input, output, session) {
observeEvent(input$mail, {
# 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).
file <- rmarkdown::render(tempReport,
output_file = file.path(tempdir(), "report.html"),
params = params,
envir = new.env(parent = globalenv())
)
sendEmail(file = file)
})
}
shinyApp(ui, server)
By the way, there's also an IMmailgun package in case you're interested, but it achieves essentially what you do with this code.

Resources