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
Related
I am writing a shiny app which:
creates a gt table
saves the gt table as an image (temporary file)
passes that image into a word doc using {officer} package
I am having difficulty with the image creation .... any help appreciated... here is my reprex
library(shiny)
library(gt)
library(dplyr)
ui <- fluidPage(
downloadButton("report", "Generate Report")
)
server <- function(input, output, session) {
my_table <- render_gt(
mtcars[1:5,1:5] %>%
gt()
)
my_image <-reactive({
outfile <- tempfile(fileext='.png')
gtsave(my_table, outfile, width = 400, height = 300)
})
output$report <- downloadHandler(
filename = function() {
"download.docx"
},
content = function(file) {
print(read_docx() %>%
body_add_img(my_image()),
target = file)
},
contentType = "docx"
)
}
shinyApp(ui, server)
There are several issues with your code:
You use render_gt instead of reactive.
Your reactive my_image does not return the name of the temporary file which is needed to add it to the docx. Additionally, as my_table is or should be a reactive use my_table()
In gtsave use vwidth and vheight. See ?webshot::webshot.
In officer::body_add_img you have to set a width and height in inches.
Reproducible code:
library(shiny)
library(gt)
library(dplyr)
library(officer)
ui <- fluidPage(
downloadButton("report", "Generate Report")
)
server <- function(input, output, session) {
my_table <- reactive({
mtcars[1:5, 1:5] %>%
gt()
})
my_image <- reactive({
outfile <- tempfile(fileext = ".png")
gtsave(my_table(), outfile, vwidth = 400, vheight = 300)
outfile
})
output$report <- downloadHandler(
filename = function() {
"download.docx"
},
content = function(file) {
read_docx() %>%
body_add_img(my_image(), width = 4, height = 3) %>%
print(target = file)
},
contentType = "docx"
)
}
shinyApp(ui, server)
I am making an app which can generate plots from input and it has no problem showing it on the UI but when I try to zip it by putting them into a temporary directory using ggsave() and use zip(), it doesn't work.
The example I have here generated the plot file in the temporary directory, but no zip file was generated. There is an extra directory in the temp dir which makes me think it has tried the process but somehow stopped.
Here is my code:
library(tidyverse)
library(shiny)
data(iris)
write.csv(iris,"C:/Users/User/Downloads/iris.csv") # I generated this file as input for the app to work
#UI
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput("file1", "Choose CSV File", accept = ".csv"), # input button
downloadButton("dl", label = "Download zip!") #download button
),
mainPanel(plotOutput("plot")) # showing the plot
)
)
server <- function(input, output, session) {
# read input file
up_res <- reactive({
inFile <- input$file1
if (is.null(inFile)) {
return(NULL)
}
read.csv(inFile$datapath)
})
# generate plot
output$plot <- renderPlot({
g <<- ggplot(up_res(), aes(x = Sepal.Length, y = Petal.Length)) +
geom_dotplot(binaxis='y', stackdir='center')
return(g)
})
# supposed to create zip file containing png file of plot
output$dl <- downloadHandler(
filename = function() {
paste('iris-', Sys.Date(), '.zip', sep='')
},
content = function(comp) {
owd <- setwd(tempdir())
on.exit(setwd(owd))
ggsave("iris.png",plot = g, device = "png")
zip(zipfile = comp, files = "iris.png")
if(file.exists(paste0(comp,".zip"))) {file.rename(paste0(comp, ".zip"), comp)}
#this is added as advised online zip may have read the pathway name wrongly from downloadHandler's content argument. but omitting it or not the results are the same
}
)
}
shinyApp(ui = ui, server = server)
When running this on Windows make sure zip works. See this related article and follow the procedure in section "Putting Rtools on the PATH".
The following works as intended:
library(ggplot2)
library(shiny)
data(iris)
write.csv(iris, "iris.csv")
print(getwd())
#UI
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput("file1", "Choose CSV File", accept = ".csv"), # input button
downloadButton("dl", label = "Download zip!") #download button
),
mainPanel(plotOutput("plot")) # showing the plot
)
)
server <- function(input, output, session) {
# read input file
up_res <- reactive({
inFile <- input$file1
if (is.null(inFile)) {
return(NULL)
}
read.csv(inFile$datapath)
})
# generate plot
myPlot <- reactiveVal(ggplot())
output$plot <- renderPlot({
g <- ggplot(req(up_res()), aes(x = Sepal.Length, y = Petal.Length)) +
geom_dotplot(binaxis='y', stackdir='center')
myPlot(g)
return(g)
})
# supposed to create zip file containing png file of plot
output$dl <- downloadHandler(
filename = function() {
paste('iris-', Sys.Date(), '.zip', sep='')
},
content = function(comp) {
pngPath <- normalizePath(file.path(tempdir(), "iris.png"))
ggsave(pngPath, plot = myPlot(), device = "png")
zip(zipfile = comp, files = pngPath, extras = '-j')
}
)
}
shinyApp(ui = ui, server = server)
I am trying to plot several images saved in the www sub-directory folder of my shiny app folder. The image file names are in a data frame column; let’s say “img_path”.
I am using the imageOutput() function in the UI and renderImage() in the server interface.
Since I want to plot all the images in the www subfolder and that are referenced in the data frame, I am using a for loop.
Unfortunately, instead of rendering all the images, it always displays the last image. I guess this is happening because images are being overlayed on top of each other.
Let say that I have: my data
df_img <- data.frame(id = c(1:5), img_path = c("h1000.png", "h2000.png", "h3000.png", "h4000.png", "h000.png"))
which is stored in the data subfolder; the 5 images in the www subfolder are named as in the df_img[["img_path"]].
My basic shiny app code is:
library(shiny)
library(shinydashboard)
Define UI
ui <- fluidPage(
# Application title
titlePanel("Test app"),
# to render images in the www folder
box(imageOutput("houz"), width = 3)
)
Define server logic
server <- function(input, output) {
df_img <- read.csv("data/df_img.csv", header = T)
for (i in 1:nrow(df_img)) {
output$houz <- renderImage({
list(
src = file.path('www', df_img$img_path[i]),
contentType = "image/jpeg",
width = "100%", height = "45%"
)
}, deleteFile = FALSE)
}
}
# Run the application
shinyApp(ui = ui, server = server)
what_i_expect and what_i_get
Consider using Shiny modules. A working example is below, which assumes you have images with a "jpeg" extension in a "www" subdirectory of the working directory. I use purrr for functional programming - you could use lapply() or a for loop if you prefer.
Chapter 19 of Mastering Shiny is a good introduction to Shiny modules.
library(shiny)
library(purrr)
ui_module <- function(id) {
imageOutput(NS(id, "img"))
}
server_module <- function(id,
img_path) {
moduleServer(
id,
function(input, output, session) {
output$img <- renderImage({
list(src = img_path,
contentType = "image/jpeg",
width = "100%",
height = "45%")
},
deleteFile = FALSE)
})
}
images <- list.files(path = "www",
pattern = "jpeg",
full.names = TRUE)
ids <- tools::file_path_sans_ext(
basename(images)
)
ui <- fluidPage(
map(ids, ui_module)
)
server <- function(input, output, session) {
map2(.x = ids,
.y = images,
.f = server_module)
}
shinyApp(ui, server)
You can use renderUI to display the list of images you wish to display. Try this
df_img <- data.frame(id = c(1:5), img_path = c("h1000.png", "h2000.png", "h3000.png", "h4000.png", "h000.png"))
ui <- fluidPage(
# Application title
titlePanel("Test app"),
# to render images in the www folder
box(uiOutput("houz"), width = 3)
)
server <- function(input, output) {
#df_img <- read.csv("data/df_img.csv", header = T)
n <- nrow(df_img)
observe({
for (i in 1:n)
{
print(i)
local({
my_i <- i
imagename = paste0("img", my_i)
print(imagename)
output[[imagename]] <-
renderImage({
list(src = file.path('www', df_img$img_path[my_i]),
width = "100%", height = "55%",
alt = "Image failed to render")
}, deleteFile = FALSE)
})
}
})
output$houz <- renderUI({
image_output_list <-
lapply(1:n,
function(i)
{
imagename = paste0("img", i)
imageOutput(imagename)
})
do.call(tagList, image_output_list)
})
}
# Run the application
shinyApp(ui = ui, server = server)
I have a shiny app that uploads pdfs to do some checks on them and write a report to a table for the user to see. One of the requirements is to create a link to the document that downloads the initial uploaded pdf. Is there a way to access the temp directory files for download and put that download link in a DT datatable? I've tried coping files to www and they can be accessed that way but when the session ends the files are not deleted.
library(shiny)
library(DT)
ui <- fluidPage(
fileInput('pdfFile',
'Upload PDF',
multiple = TRUE,
accept = c('.pdf')),
DTOutput('Table')
)
server <- function(input, output) {
output$Table <- renderDT({
pdfTable <- cbind(input$pdfFile,
pdflink = sprintf('%s',
input$pdfFile$datapath,
input$pdfFile$name,
input$pdfFile$name),
stringsAsFactors = FALSE)
datatable(pdfTable,escape = FALSE)
})
}
shinyApp(ui = ui, server = server)
You can use session$onSessionEnded to execute some code after the client has disconnected (I confess I never tried):
server <- function(input, output, session) {
session$onSessionEnded(function(){
file.remove(......)
})
output$Table <- renderDT({
pdfTable <- cbind(input$pdfFile,
pdflink = sprintf('%s',
input$pdfFile$datapath,
input$pdfFile$name,
input$pdfFile$name),
stringsAsFactors = FALSE)
datatable(pdfTable, escape = FALSE)
})
}
I wasn't able to get the downloadButton to appear in the table, but the otherwise I believe the following meets your requirements. The basic idea is to copy the uploaded file to a new tempfile whose location gets saved in a reactiveVal until needed.
library(shiny)
library(tidyverse)
library(DT)
ui <- fluidPage(
fileInput('pdfFile',
'Upload PDF',
multiple = TRUE,
accept = c('.pdf')),
downloadButton("download_button", "Download Selected File"),
DTOutput('Table')
)
server <- function(input, output) {
output$Table <- renderDT({
uploaded_df() %>%
select(-temp) %>%
datatable(selection = "single")
})
uploaded_df <- reactiveVal(tibble(name = character(), temp = character()))
observeEvent(input$pdfFile,{
temp_file_location <- tempfile(fileext = ".pdf")
file.copy(input$pdfFile$datapath, temp_file_location)
tibble(name = input$pdfFile$name,
temp = temp_file_location) %>%
bind_rows(uploaded_df(), .) %>%
uploaded_df()
})
output$download_button <- downloadHandler(
filename <- function() {
req(input$Table_rows_selected)
uploaded_df()$name[[input$Table_rows_selected]]
},
content <- function(file) {
file.copy(uploaded_df()$temp[[input$Table_rows_selected]], file)
}
)
}
shinyApp(ui = ui, server = server)
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