I have an R shiny app using the compare_df function as part of the compareDF package and it produces an HTML output. I was wondering how to export this as an HTML file using downloadHandler? This is my attempt:
Partial Code
ui <- fluidPage(
sliderPanel(
downloadButton("Export_HTML", "Export as Data Listing")
),
# Main panel for displaying outputs ----
mainPanel(uiOutput('html'))
)
server <- function(input,output){
a<-- c("1","2","3")
diff<-compare_df(filedata2, filedata1, group_col = a)
output$html <- renderUI({
HTML(knit2html(text=diff[["html_output"]], fragment.only=TRUE))
})
output$Export_HTML <- downloadHandler(
filename = function() {
paste("Comparison-", Sys.Date(), ".html", sep = "")
},
content = function(file) {
saveWidget(as_widget(diff[["html_output"]]), file, selfcontained = TRUE)
}
)
}
To download html file when comparing two datasets, we need to have two files in application structure
app.R
report.Rmd
app.R
library(shiny)
library(diffobj)
library(rmarkdown)
ui <- fluidPage(
sidebarPanel(
downloadButton('downloadReport')
),
# Main panel for displaying outputs ----
mainPanel(htmlOutput('html'))
)
server <- function(input,output){
filedata1 <- data.frame(a = c(1,2,3,4), b= c(3,5,8,9))
filedata2 <- data.frame(a = c(1,2,3,4), b= c(4,5,8,10))
output$html <- renderUI({
HTML(as.character(diffPrint(filedata2, filedata1, color.mode="rgb", format="html",
style=list(html.output="diff.w.style"))))
})
output$downloadReport <- downloadHandler(
filename = function() {
paste('Compare-report', "html", sep = '.')
},
content = function(file) {
src <- normalizePath('report.Rmd')
# temporarily switch to the temp dir, in case you do not have write
# permission to the current working directory
owd <- setwd(tempdir())
on.exit(setwd(owd))
file.copy(src, 'report.Rmd', overwrite = TRUE)
out <- render('report.Rmd')
file.rename(out, file)
}
)
}
shinyApp(ui = ui, server = server)
report.Rmd
```{r, echo=FALSE}
filedata1 <- data.frame(a = c(1,2,3,4), b= c(3,5,8,9))
filedata2 <- data.frame(a = c(1,2,3,4), b= c(4,5,8,10))
HTML(as.character(as.character(diffPrint(filedata2, filedata1, color.mode="rgb", format="html",
style=list(html.output="diff.w.style")))))
```
You may want to take a look at the Shiny Tutorial page on using the download handler to produce HTML through an R Markdown template: https://shiny.rstudio.com/articles/generating-reports.html
Related
I made an R script that allows to get an R Markdown report with a certain type of dataset. Now I would like other people to be able to use this script in order to get an automated report with their data but without using this script (especially for people who don't master R).
I try to go through Shiny hoping to make an interface that loads a dataset and would make my script automatically but I can't make the link between Shiny and my Rmd.
How can I tell my Rmd that the dataset to be processed is not the one that my Rmd script was going to look for in a directory but the one that was loaded on the Shiny interface?
Thanks
Here is the Shiny script with my Rmd called "traitemant_bis.Rmd" :
library(shiny)
library(rmarkdown)
ui <- fluidPage(
titlePanel("Uploading Files"),
sidebarLayout(
sidebarPanel(
fileInput(
inputId = "file1", label = "Choose CSV File",
multiple = FALSE,
accept = c("text/csv", "text/comma-separated-values,text/plain", ".csv")
),
radioButtons("format", "Document format", c("PDF", "HTML", "Word"), inline = TRUE)
),
mainPanel(
tableOutput("contents"),
downloadButton("downloadReport")
)
)
)
server <- function(input, output) {
dataset <- reactive({
req(input$file1)
read.csv(file = input$file1$datapath,
na.strings = ".",
sep = ";",
header = TRUE,
nrows=10)
})
output$contents <- renderTable({
req(dataset())
head(dataset())
})
output$downloadReport <- downloadHandler(
filename = function() {
paste("my-report", sep = ".", switch(
input$format, PDF = "pdf", HTML = "html", Word = "docx"
))
},
content = function(file) {
src <- normalizePath("traitemant_bis.Rmd")
owd <- setwd(tempdir())
on.exit(setwd(owd))
file.copy(src, "traitemant_bis.Rmd", overwrite = TRUE)
out <- render("traitemant_bis.Rmd", switch(
input$format,
PDF = pdf_document(), HTML = html_document(), Word = word_document()
))
file.rename(out, file)
}
)
}
shinyApp(ui, server) ```
I'm giving a simple example showing how you can achieve this. Basically, you can pass any of your data from shiny to Rmd as params.
If you have multiple data frames or any data convert them to a single list and pass as params, you can extract individual data later in the RMarkdown
app.R
library(shiny)
ui <- fluidPage(
# Application title
titlePanel("RMD example"),
downloadButton("btn", "Generate Report")
)
# Define server logic required to draw a histogram
server <- function(input, output) {
data <- reactive({
mtcars
})
output$btn <- downloadHandler(
filename = function(){"myreport.docx"},
content = function(file) {
tempReport <- file.path(tempdir(),"markdown.Rmd")
file.copy("markdown.Rmd", tempReport, overwrite = TRUE)
rmarkdown::render("markdown.Rmd", output_format = "word_document", output_file = file,
params = list(table = data()), # here I'm passing data in params
envir = new.env(parent = globalenv()),clean=F,encoding="utf-8"
)
}
)
}
# Run the application
shinyApp(ui = ui, server = server)
Rmd file
---
title: "Untitled"
author: "Mohan"
date: "2/17/2021"
params:
table: [some object]
output: word_document
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```
## R Markdown
This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see <http://rmarkdown.rstudio.com>.
When you click the **Knit** button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this:
```{r cars}
params$table -> data
data
summary(data)
```
I've made an shiny app where I'm filtering a dataset using some values and then I would like to be able to download that filtered dataset. However, I'm struggling to understand how I can pass the filtered dataset to the csv downloader. It is a very large dataset so can't use the buttons available in renderDataTable (I think?) Does anyone have any ideas of how I can do this?
Example app:
### data ###
egDf <- data.frame(col1 = sample(letters,10000,replace=T), col2 = sample(letters,10000, replace=T))
### modules ###
chooseCol1UI <- function(id){
ns <- NS(id)
uiOutput(ns('chooserCol1'))
}
chooseCol1 <- function(input, output, session, data){
output$chooserCol1 <- renderUI({
ns <- session$ns
pickerInput(inputId = ns('chosenCol1'),
label = 'Col1',
choices = paste(sort(unique(egDf$col1))),
options = list(`actions-box` = TRUE),
multiple = TRUE)
})
return(reactive(input$chosenCol1))
}
csvDownloadUI <- function(id, label = "Download CSV") {
ns <- NS(id)
downloadButton(ns("downloadData"), label)
}
csvDownload <- function(input, output, session, data) {
output$downloadData <- downloadHandler(
filename = function() {
paste(names(data), Sys.Date(), '.csv', sep='')
},
content = function(file) {
write.csv(data, file, row.names = FALSE)
}
)
}
displayTableUI <- function(id){
ns <- NS(id)
DT::dataTableOutput(ns('displayer'))
}
displayTable <- function(input, output, session, data, col1Input){
output$displayer <- DT::renderDataTable(egDf %>% filter(col1 %in% col1Input()))
}
### server ###
server <- function(input,output){
chosenCol1 <- callModule(chooseCol1,
id = 'appChooseCol1', data = egDf)
callModule(module = displayTable, id = "appDisplayTable",
col1Input = chosenCol1)
}
### ui ###
ui <- fluidPage(
sidebarPanel(
chooseCol1UI("appChooseCol1")),
mainPanel(displayTableUI("appDisplayTable")))
### app ###
shinyApp(ui = ui, server = server)
A few years ago I made an app with such a button. In my case I created a reactive expression in the server.R file that is being passed to the downloadHandler.
Here's the app and here's the github code. Head to the server.R file and search for the "download" string.
In the app you'll find a blue download button in the "Data" tab. The app let's you apply filters that applies in the datatable, that you can download via the button.
Edit: here's the server portion of code of interest:
#data download button
output$idDwn <- downloadHandler(
filename = function() {
paste('uCount ', format(Sys.time(), "%Y-%m-%d %H.%M.%S"), '.csv', sep='')
},
content = function(file) {
write.csv(datasetInputFilters(), file)
}
)
I would create eventReactive function that allows your col1Input.
# Reactive function based on input
react_df <- eventReactive(input$chosenCol1, {
return(egDf %>% filter(col1 %in% input$chosenCol1))
})
output$displayer <- renderDataTable(react_df())
# Download box
output$downloadData <- downloadHandler(
filename = function() {
paste("data-", Sys.Date(), ".csv", sep="")
},
content = function(file) {
output_d <- react_df()
write.csv(output_d, file, row.names = FALSE)
}
)
I dealt with this issue recently and unfortunately that solution didn't work for me. But simply using writexl::write_xlsx() instead of write.csv() was enough.
I am trying to download output from wordcloud2 on shiny.
My code is as below:
library(shiny)
library(htmlwidgets)
library(webshot)
ui <- shinyUI(fluidPage(mainPanel(
wordcloud2Output("wordcl"),
downloadButton(outputId = "savecloud"),
downloadButton(outputId = "savecloud2")
)))
server <- shinyServer(function(input, output, session) {
wordcl <- reactive ({
wordcloud2(demoFreq, color = "random-light", backgroundColor = "grey")
})
output$wordcl <- renderWordcloud2({ wordcl() })
##### SOLUTION 1 #########
output$savecloud <- downloadHandler(
filename = "word.png",
content = function(cloud) {
file.copy(wordcl(), cloud)
})
##### SOLUTION 2 ##########
output$savecloud2 <- downloadHandler(
saveWidget(wordcl(), file="temp.html", selfcontained = F),
webshot("temp.html", file = "word2.png",
cliprect = "viewport")
)
})
shinyApp(ui = ui, server = server)
I have tried two styles using downloadhandler as shown in the code but they return empty results.
Any insight on why they downloadhandler doesn't work or redirection on how best to effect the download function will be appreciated.
I managed to make my download work by using an example of download handler function posted on LeafletMaps here: Why is webshot not working with leaflets in R shiny?
My updated code is as below:
library(shiny)
library(htmlwidgets)
library(webshot)
library(wordcloud2)
#webshot::install_phantomjs()
ui <- shinyUI(fluidPage(mainPanel(
wordcloud2Output("wordcl"),
downloadButton(outputId = "savecloud")
)))
server <- shinyServer(function(input, output, session) {
wordcl <- reactive ({
wordcloud2(demoFreq, color = "random-light", backgroundColor = "grey")
})
output$wordcl <- renderWordcloud2({
wordcl()
})
output$savecloud <- downloadHandler(
filename = paste("wordcloud", '.png', sep=''),
content = function(file) {
owd <- setwd(tempdir())
on.exit(setwd(owd))
saveWidget(wordcl(), "temp.html", selfcontained = FALSE)
webshot("temp.html", delay =15, file = file, cliprect = "viewport")
})
})
shinyApp(ui = ui, server = server)
The solution given on the link seems to combine the solutions I was trying to implement in my original post.
The only issue is that it does not work when the app is deployed on shiny.io
I am still learning R and thus would request the experts in this platform to help me out.
I am trying to create a slideshow of .jpg images in a panel in Shiny. The below code when I run in RStudio gives me the slideshow in the Plot window of RStudio.
folder <- "D:/Photos/Foreign Trips/2014_07_08_USA_Irvine/JulyAugust/"
file_list <- list.files(path=folder, pattern="*.jpg", full.names = TRUE)
for (j in 1:30) {
myJPG <- stack(file_list[[j]])
plotRGB(myJPG)
}
But, when I try to put the same code in server.R and try to call through ui.R, I don't get the slideshow or any image getting displayed. I am getting a blank page when I click on the tab "Photo Slides". I tried using renderUI, renderImage and renderPlot but none works.
ui.R
tabPanel("Photo Slides",
plotOutput("trvImg")
),
server.R
output$trvImg <- renderPlot({
folder <- "D:/Photos/Foreign Trips/2014_07_08_USA_Irvine/JulyAugust/"
file_list <- list.files(path=folder, pattern="*.jpg", full.names = TRUE)
for (j in 1:30) {
myJPG <- stack(file_list[[j]])
plotRGB(myJPG)
}
As a learner, I am sure I'm going wrong somewhere and thus seek your help.
Thanks
Another solution, with the slickR package (based on the slick javascript library).
library(shiny)
library(slickR)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
####
),
mainPanel(
slickROutput("slickr", width="500px")
)
)
)
server <- function(input, output) {
output$slickr <- renderSlickR({
imgs <- list.files("D:/Photos/Foreign Trips/2014_07_08_USA_Irvine/JulyAugust/", pattern=".png", full.names = TRUE)
slickR(imgs)
})
}
# Run the application
shinyApp(ui = ui, server = server)
library(shiny)
imgs <- list.files("D:/Photos/Foreign Trips/2014_07_08_USA_Irvine/JulyAugust/", pattern=".png", full.names = TRUE)
ui <- fluidPage(
titlePanel("Slideshow"),
sidebarLayout(
sidebarPanel(
actionButton("previous", "Previous"),
actionButton("next", "Next")
),
mainPanel(
imageOutput("image")
)
)
)
server <- function(input, output, session) {
index <- reactiveVal(1)
observeEvent(input[["previous"]], {
index(max(index()-1, 1))
})
observeEvent(input[["next"]], {
index(min(index()+1, length(imgs)))
})
output$image <- renderImage({
x <- imgs[index()]
list(src = x, alt = "alternate text")
}, deleteFile = FALSE)
}
# Run the application
shinyApp(ui = ui, server = server)
If you want the buttons below the image, you can do:
sidebarLayout(
sidebarPanel(
# actionButton("previous", "Previous"),
# actionButton("next", "Next")
),
mainPanel(
imageOutput("image"),
fluidRow(
column(1, offset=1, actionButton("previous", "Previous")),
column(1, offset=1, actionButton("next", "Next"))
)
)
)
I wanted to do the same, but needed a static html output so couldn't use Shiny. I created a simple revealjs presentation and then included this in the flexdashboard as an iframe.
revealjs:
---
title:
output:
revealjs::revealjs_presentation:
transition: convex
reveal_options:
loop: true
autoSlide: 3000
keyboard: false
progress: false
shuffle: true
embedded: true
---
```{r setup, include=FALSE}
library(tidyverse)
library(glue)
library(pander)
```
```{r echo = FALSE, results ='asis'}
files <- list.files(path="./path/to/dir", full.names = TRUE)
headers <- lapply(files,
function(f){glue("{data-background='{{f}}'}",
.open = "{{",
.close = "}}")
})
pandoc.header(headers, 2)
```
Then in my flexdashboard I added:
```{r}
tags$iframe(style = "height:400px; width:100%; scrolling=yes",
src ="./imageSlider.html")
```
I have created an R shiny application to download dynamic reports using R Markdown. Previously I was downloading one report at a time by selecting the row in the data table in r shiny and clicking on download button, the selected row's column values would get filled in the report, this was working perfectly fine.
But now i am trying to download multiple reports, so that if I select multiple rows in a datatable in r shiny and click on download, the number of reports downloaded should be equal to number of rows selected.
For this I am trying to create a zip file which contains all my individual report but I am getting this
error: pandoc document conversion failed with error 1
I had researched for this error but couldn't find anything. Please help!
ui <- {
tagList(
div(id = "downloadBtn",
downloadButton("downloadData", "Download")),
DT::dataTableOutput('myTable1')
)
}
dataJ <- read.csv(file = "iris.csv", header = TRUE, stringsAsFactors =
FALSE)
server <- function(input, output)
{
output$myTable1 <- DT::renderDataTable({
DT::datatable(dataJ, options = list(orderClasses = TRUE), filter = 'top')})
output$downloadData <- downloadHandler(
filename = function()
{
paste("output", "zip", sep = ".")
},
content = function(file)
{
k = list(input$myTable1_rows_selected)
fs <- c()
for ( i in k)
{
params <- list(j=i)
path <- paste(i,".docx")
rmarkdown::render("R_markdown_script.Rmd", rmarkdown::word_document(),
output_file = path , params = params,
envir = new.env(parent = globalenv()))
fs <- c(fs,path)
}
zip(zipfile = file, files = fs)
if (file.exists(paste0(file, ".zip")))
file.rename(paste0(file, ".zip"), file)
},
contentType = "application/zip" )
}
runApp(list(ui = ui, server = server))
Here is a reproducible example (to make it work, create an rmarkdown file with the default content using RStudio, and save it as "test.rmd" in the same folder as your Shiny app).
Important:
You need to run the app externally inside your web browser. Somehow it does not work in the viewer pane or RStudio window (you get the download window but then no file is saved).
If you are on Windows, you need to make sure that you install RTools first, and also put the rtools/bin folder in your system path.
app.R
library(shiny)
ui <- shinyUI(fluidPage(
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
downloadButton("downloadData", "Download")
),
mainPanel(
DT::dataTableOutput('myTable1')
)
)
))
server <- shinyServer(function(input, output) {
output$myTable1 <- DT::renderDataTable(iris)
output$downloadData <- downloadHandler(
filename = function() {
paste0("output", ".zip")
},
content = function(file) {
k <- input$myTable1_rows_selected
fs <- c()
for (i in k) {
path <- paste0(i, ".docx")
rmarkdown::render("test.rmd", rmarkdown::word_document(), output_file = path)
fs <- c(fs, path)
}
zip(file, fs)
},
contentType = "application/zip"
)
})
shinyApp(ui = ui, server = server)
Hello I also installed Rtools/bin and was running the code on the web browser, but when I click on download button, download window doesn't comes up and shows '404 Not Found', but when I check the directory, the doc files report are saving directly to directory, no zip file is produced. Please see below code.
ui <- {
tagList(
div(id = "downloadBtn",
downloadButton("downloadData", "Download")),
DT::dataTableOutput('myTable1')
)
}
dataJ <- read.csv(file = "iris.csv", header = TRUE, stringsAsFactors =
FALSE)
server <- function(input, output)
{
output$myTable1 <- DT::renderDataTable({
DT::datatable(dataJ, options = list(orderClasses = TRUE), filter = 'top')})
output$downloadData <- downloadHandler(
filename = ("output.zip"),
content = function(file)
{
k <- (input$myTable1_rows_selected)
fs <- c()
for ( i in k)
{
path <- paste0(i,".docx")
rmarkdown::render("R_markdown_script.Rmd", output_file = path ,
params = list(j=i), envir = new.env(parent = globalenv()))
fs <- c(fs,file)
}
zip(zipfile = file, files = fs)
},
contentType = "application/zip" )
}
runApp(list(ui = ui, server = server))`