R Shiny - Wordcloud2 breaking downloadButton - r

I want to create several wordclouds, using wordcloud and wordcloud2 packages.
I can create a download for the wordcloud created by the wordcloud package, but as soon as I render a wordcloud2-wordcloud, the download button breaks (only allows to download .html instead of .png).
I've added an example to reproduce it:
library("shiny")
library("wordcloud")
library("wordcloud2")
library("tm")
ui <- fluidPage(plotOutput("plot1"), downloadButton('plot1download'))
server <- function(input, output, session) {
output$plot1 <- renderPlot({
wordcloud(data(crude))
})
output$plot2 <- renderWordcloud2({
wordcloud2(demoFreq)
})
output$plot1download <- downloadHandler(
filename = function() {
paste('wordcloud', '.png', sep='')
},
content = function(file) {
device <- function(..., width, height) grDevices::png(...)
ggsave(file, plot = wordcloud(data(crude)), device = device)
}
)
}
shinyApp(ui, server)
The code above works, but if I add another plot (plotOutput("plot2")), it breaks:
library("shiny")
library("wordcloud")
library("wordcloud2")
library("tm")
ui <- fluidPage(plotOutput("plot1"), downloadButton('plot1download'), wordcloud2Output("plot2"))
server <- function(input, output, session) {
output$plot1 <- renderPlot({
wordcloud(data(crude))
})
output$plot2 <- renderWordcloud2({
wordcloud2(demoFreq)
})
output$plot1download <- downloadHandler(
filename = function() {
paste('wordcloud', '.png', sep='')
},
content = function(file) {
device <- function(..., width, height) grDevices::png(...)
ggsave(file, plot = wordcloud(data(crude)), device = device)
}
)
}
shinyApp(ui, server)
Anyone has an idea why this happens and how to resolve the issue?

This seems to be a bug in the CRAN version of wordcloud2. Install the development version from GitHub with
remotes::install_github("lchiffon/wordcloud2")
for a fix.

Related

How to fix namespace error when running zip?

I'm getting a namespace error when I run the code below as follows: Warning: Error in : 'zipr' is not an exported object from 'namespace:zip'
[No stack trace available]. Any suggestions on what this could be due to? Thanks in advance.
library(shiny)
library(ggplot2)
ui <- fluidPage(
plotOutput("p1"),
plotOutput("p2"),
plotOutput("p3"),
downloadButton("allgraphs", "Download")
)
server = function(input, output) {
df<-data.frame(q=c(1,3,5,7,9),w=c(2,4,6,8,10),z=c(1,2,3,4,5))
p1 <- reactive({
ggplot(df,aes(x=q,y=w)) + geom_point()
})
p2 <- reactive({
ggplot(df,aes(x=z,y=w))+geom_point()
})
p3 <- reactive({
ggplot(df,aes(x=q,y=z))+geom_point()
})
output$p1 <- renderPlot({
p1()
})
output$p2 <- renderPlot({
p2()
})
output$p3 <- renderPlot({
p3()
})
output$allgraphs = downloadHandler(
filename = function() {
'all_images.zip'
},
content = function(fname) {
fs <- replicate(3, tempfile(fileext = ".png"))
ggsave(fs[1], p1())
ggsave(fs[2], p2())
ggsave(fs[3], p3())
zip::zipr(zipfile=fname, files=fs)
},
contentType = "application/zip")
}
shinyApp(ui, server)
You need to update your zip package to latest version. I had the same issue with version 1.0.0 of zip which doesn't exports any zipR object and openxlsx loading would fail. The upgrade of zip to v2.1.0, which indeed exports a zipR object, solved the issue.

Downloading wordcloud2 output as png/jpg on shiny

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

Download a ggplotly() object as a .png through a shiny app which runs in a browser

Is it possible to download a ggplotly() object as .png like a ggplot() object in a shiny application which you open in a browser. I have found some ways to download a ggplot but none for ggplotly. If there is no way is there some hacky alternative?
library(shiny)
library(plotly)
ui <- fluidPage(
plotlyOutput("plot"),
verbatimTextOutput("event"),
downloadButton("download","Download Plot")
)
server <- function(input, output) {
# renderPlotly() also understands ggplot2 objects!
save<-reactive({
plot_ly(mtcars, x = ~mpg, y = ~wt)
})
output$plot <- renderPlotly({
ggplotly(save())
})
output$download <- downloadHandler(
filename = function() {
paste("down", ".png", sep="")
},
content = function(file) {
ggsave(file, plot = save())
}
)
}
shinyApp(ui, server)

saving multiple plots in a single PDF in Shiny R

I am trying to export ggplots in my Shiny App into a single PDF file using the download handler but it is not working. The PDF file is getting saved but it gives me only the last ggplot instead of all three. Any help would be appreciated!
Below is the code of the server:
shinyServer(function(input, output, session) {
plotinput()
{
df<-data.frame(q=c(1,3,5,7,9),w=c(2,4,6,8,10),z=c(1,2,3,4,5))
ggplot(df,aes(x=q,y=w))+geom_point()
ggplot(df,aes(x=z,y=w))+geom_point()
ggplot(df,aes(x=q,y=z))+geom_point()
}
output$allgraphs <- downloadHandler(
filename = function(){paste0("graphs.pdf")},
content = function(file){
pdf(file,onefile = TRUE)
print(plotinput())
dev.off()
}
)
})
We could do this with
library(shiny)
library(grid)
library(gridExtra)
runApp(list(
ui = fluidPage(downloadButton('allgraphs')),
server = function(input, output) {
plotinput <- function() {
df<-data.frame(q=c(1,3,5,7,9),w=c(2,4,6,8,10),z=c(1,2,3,4,5))
list(p1 = ggplot(df,aes(x=q,y=w))+geom_point(),
p2 = ggplot(df,aes(x=z,y=w))+geom_point(),
p3 = ggplot(df,aes(x=q,y=z))+geom_point())
}
output$allgraphs = downloadHandler(
filename = 'graphs.pdf',
content = function(file) {
pdf(file)
arrangeGrob(print(plotinput()[['p1']]),
print(plotinput()[['p2']]),
print(plotinput()[['p3']]), ncol = 3)
dev.off()
})
}
))
-output
allgraphs.pdf
1
2
3

R Shiny downloadHandler returns app html rather than plots or data

I'm simply looking to return a user-produced plot (built in ggplot) or a data table from an app built from modules and a plotting helper function. I've seen many posts about downloadHandler being very finicky and there even appears to be open issues with some of downloadHandler's behaviours. The odd behaviour I'm getting, which I haven't seen posts about, is that it returns an html page of my app instead of the plot, regardless of how I try to save the plot (i.e., using pdf/png devices, ggsave(), etc.), or whether I use suspendWhenHidden. I can run the plot saving code external to Shiny and it works fine. I'm running all of this from the browser (Firefox, though Chrome does the same) on a mac, with recently updated everything.
Example code below.
Modules:
library(shiny)
library(ggplot2)
# UI module
modUI <- function(id, label="inputvalues") {
ns <- NS(id)
tagList(
numericInput(ns("mean"), "Mean",value = NULL),
numericInput(ns("sd"),"Std. Dev.",value = NULL),
actionButton(ns("draw"),"Draw plot"),
downloadButton(ns("dlPlot"), "Download Plot")
)
}
# Server Logic module
mod <- function(input, output, session) {
x <- reactiveValues(data=NULL)
observeEvent(input$draw, {
x$data <- rnorm(100,input$mean,input$sd)
})
return(list(dat = reactive({x$data}),
m = reactive({input$mean}),
s = reactive({input$sd})
)
)
}
Plotting helper function:
showPlot <- function(data, m, s) {
d <- data.frame(data)
p <- ggplot(d, aes(x=d, y=d)) +
geom_point() +
geom_vline(xintercept=m)
p
}
UI and Server calls:
ui <- navbarPage("Fancy Title",id = "tabs",
tabPanel("Panel1",value = 1,
sidebarPanel(
modUI("input1")
),
mainPanel(plotOutput("plot1"))
)
)
server <- function(input, output, session) {
y <- callModule(mod, "input1")
output$plot1 <- renderPlot({
if (is.null(y$dat())) return()
showPlot(data.frame(y$dat()), y$m(), y$s())
})
output$dlPlot <- downloadHandler(
filename="~Plot_Download.pdf",
content=function(file){
pdf(filename, file)
p
dev.off()
}
)
}
shinyApp(ui, server)
Thanks as always for any help!
Finally figured out an answer to this, based in large part on this post. The answer is to create a server module specifically for the download (which can take the session and namespace info), and then to call that module in the server. Additional and updated code below:
The new download module:
dlmodule <- function(input, output, session) {
output$dlPlot <- downloadHandler(
filename="Plot_Download.pdf",
content=function(file){
ggsave(file, device = pdf, width = 7,height = 5,units = "in",dpi = 200)
}
)
}
The updated server call:
server <- function(input, output, session) {
y <- callModule(mod, "input1")
output$plot1 <- renderPlot({
if (is.null(y$dat())) return()
showPlot(data.frame(y$dat()), y$m(), y$s())
})
dl.y <- callModule(dlmodule, "input1")
}
Everything else stays the same.

Resources