I have part of a shiny function where the user selects the download image type (.png, .tiff etc) and clicks a button to download it. But all options download in .png format and I can't seem to find out what is wrong.
Note that the preview is always png. The download function creates different file types upon clicking the button. Another point to note is the use of file.copy() in downloadhandler rather than something like
png(name)
plot()
dev.off()
This is because my plotting function is complex and file.copy() is more practical.
The code is below.
#ui.R ----------------------------------------------------------
shinyUI(fluidPage(
titlePanel("Download test"),
sidebarLayout(
sidebarPanel(
numericInput("fheight", "Height (cm)", min=2, max=15, step=1, value = 10),
numericInput("fwidth", "Width (cm)", min=2, max=15, step=1, value = 10),
selectInput("fres", "Res", choices=c("100","200","300"), selected = "100"),
selectInput("fformat", "File type", choices=c("png","tiff","jpeg","pdf"), selected = "png", multiple = FALSE, selectize = TRUE),
downloadButton('bn_download', 'Download Plot')
),
# Show a plot of the generated distribution
mainPanel(
imageOutput("plotoutput")
)
)
))
# server.R ----------------------------------------------------------
shinyServer(function(input, output) {
# store some values
store <- reactiveValues(dname="AwesomeDownload")
# data creation
fn_data <- reactive({
df <- data.frame(x=rnorm(50),y=rnorm(50))
})
# create filename
fn_downloadname <- reactive({
if(input$fformat=="png") filename <- paste0(store$dname,".png",sep="")
if(input$fformat=="tiff") filename <- paste0(store$dname,".tif",sep="")
if(input$fformat=="jpeg") filename <- paste0(store$dname,".jpg",sep="")
if(input$fformat=="pdf") filename <- paste0(store$dname,".pdf",sep="")
return(filename)
})
# render png preview
output$plotoutput <- renderImage({
df <- fn_data()
fheight <- input$fheight
fwidth <- input$fwidth
fres <- as.numeric(input$fres)
png(paste0(store$dname,".png",sep=""), height=fheight, width=fwidth, res=fres, units="cm")
plot(df)
dev.off()
return(list(src = paste0(store$dname,".png",sep=""),
contentType = "image/png",
width = round((input$fwidth*as.numeric(input$fres))/2.54, 0),
height = round((input$fheight*as.numeric(input$fres))/2.54, 0),
alt = "plot"))
},deleteFile=TRUE)
# download function
fn_download <- function()
{
df <- fn_data()
fheight <- input$fheight
fwidth <- input$fwidth
fres <- as.numeric(input$fres)
if(input$fformat=="pdf") fheight <- round(fheight*0.3937,2)
if(input$fformat=="pdf") fwidth <- round(fwidth*0.3937,2)
if(input$fformat=="png") png(fn_downloadname(), height=fheight, width=fwidth, res=fres, units="cm")
if(input$fformat=="tiff") tiff(fn_downloadname(), height=fheight, width=fwidth, res=fres, units="cm",compression="lzw")
if(input$fformat=="jpeg") jpeg(fn_downloadname(), height=fheight, width=fwidth, res=fres, units="cm",quality=100)
if(input$fformat=="pdf") pdf(fn_downloadname(), height=fheight, width=fwidth)
plot(df)
dev.off()
}
# download handler
output$bn_download <- downloadHandler(
filename = fn_downloadname(),
content = function(file) {
fn_download()
file.copy(fn_downloadname(), file, overwrite=T)
}
)
})
Removing parenthesis in the download filename fixed the issue. Yeah, don't even ask. I have no idea why this is so either. But it works.
Joe Cheng's answer:
Change this line:
filename = fn_downloadname(),
to this:
filename = fn_downloadname,
Related
I have a Shiny app which reads in data from a spreadsheet and produces two plots - a box plot and a histogram. I want to be able to download each plot separately (as png) using a download button when I have made various adjustments using sliders etc.
My plots work, and the download buttons work, but will only download one of the plots (apparently the one that was drawn most recently). In a reactive environment this is not very predictable and does not do what I want.
My question is, how do I specify in the download function which of the two plots to download?
An abbreviated version of my code is here:
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
<... various components ...>
}}
h3("Save the Box Plot"),
downloadButton("SaveBox", label = "Save Box Plot as PNG"),
h3("Save the Histogram"),
downloadButton("SaveHist", label = "Save Histogram as PNG")
),
mainPanel(
## Display the Boxplot
plotOutput("BoxPlot"),
## Display the Histogram
plotOutput("Hist"),
)
)
)
server <- function(input, output) {
############
## Read file and process data
graphData <- reactive ({
... draw box plot ...
})
################################
## Display the box plot
output$BoxPlot <- renderPlot({
...
})
################################
## Display the histogram
output$Hist <- renderPlot({
... draw histogram ...
})
################################
## Save to PNG with the plot title as a default file name.
## Skip saving if no file has been loaded
## Save file using the system file save utility so you can name it and put it where you want
output$SaveBox = downloadHandler(
filename = function(file){
ifelse (is.null(input$DataFile),return(), str_c(input$Title, ".png"))
},
content = function(file) {
ggsave(file, width = 290, height = 265, units = "mm", device = "png")
}
)
output$SaveHist = downloadHandler(
filename = function(file){
ifelse (is.null(input$DataFile),return(), str_c(input$HistTitle, ".png"))
},
content = function(file) {
ggsave(file, width = 290, height = 265, units = "mm", device = "png")
}
)
)
The issue is that you have to tell ggsave which plot you want to save. If not specified the last plot will be saved. To fix you code you could move the plot codes into reactives, which could then be called both in the renderPlots and passed to the plot argument of ggsave so that the right plot is saved:
I adjusted your code a bit to make it a reproducible example using mtcars as example data:
library(shiny)
library(ggplot2)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
h3("Save the Box Plot"),
downloadButton("SaveBox", label = "Save Box Plot as PNG"),
h3("Save the Histogram"),
downloadButton("SaveHist", label = "Save Histogram as PNG")
),
mainPanel(
## Display the Boxplot
plotOutput("BoxPlot"),
## Display the Histogram
plotOutput("Hist")
)
)
)
server <- function(input, output) {
## Read file and process data
graphData <- reactive({
mtcars
})
box_plot <- reactive({
ggplot(graphData(), aes(mpg)) +
geom_boxplot()
})
hist_plot <- reactive({
ggplot(graphData(), aes(mpg)) +
geom_histogram()
})
## Display the box plot
output$BoxPlot <- renderPlot({
box_plot()
})
## Display the histogram
output$Hist <- renderPlot({
hist_plot()
})
output$SaveBox <- downloadHandler(
filename = function(file) {
"box_plot.png"
#ifelse(is.null(input$DataFile), return(), str_c(input$Title, ".png"))
},
content = function(file) {
ggsave(file, plot = box_plot(), width = 290, height = 265, units = "mm", device = "png")
}
)
output$SaveHist <- downloadHandler(
filename = function(file) {
"hist_plot.png"
#ifelse(is.null(input$DataFile), return(), str_c(input$HistTitle, ".png"))
},
content = function(file) {
ggsave(file, , plot = hist_plot(), width = 290, height = 265, units = "mm", device = "png")
}
)
}
shinyApp(ui, server)
In my Shiny app, I produce a plot that is quite heavy. When I want to download this plot, R first produces the PNG file in the background and then opens the file system to choose where I want to save it.
The problem is that the plot creation takes some time after clicking on the download button, and therefore the user doesn't know if it worked.
Example below: the plot is a bit heavy so it takes some time to appear. Wait for it to appear before clicking on the "download" button.
library(shiny)
library(ggplot2)
foo <- data.frame(
x = sample(seq(1, 20, by = 0.01), 5*1e5, replace = TRUE),
y = sample(seq(1, 20, by = 0.01), 5*1e5, replace = TRUE)
)
ui <- fluidPage(
downloadButton('foo'),
plotOutput("test")
)
server <- function(input, output) {
output$test <- renderPlot(ggplot(foo, aes(x, y)) + geom_point())
output$foo = downloadHandler(
filename = 'test.png',
content = function(file) {
ggsave(file)
}
)
}
shinyApp(ui, server)
Is there a way to invert the process, i.e first let the user choose where to save the plot and then produce the PNG in the background? I think that would provide a better user experience.
Regarding your comment below #manro's answer: promises won't help here.
They are preventing other shiny sessions from being blocked by a busy session. They increase inter-session responsiveness not intra-session responsiveness - although there are (potentially dangerous) workarounds.
See this answer for testing:
R Shiny: async downloadHandler
In the end the downloadButton just provides a link (a-tag) with a download attribute.
If the linked resource does not exist when the client tries to access it the browser will throw an error (as it does when clicking the downloadButton before the plot is ready in your MRE).
Also the dialog to provide the file path is executed by the clients browser after clicking the link (and not by R).
I think somehow notifying the user is all you can do:
library(shiny)
library(ggplot2)
foo <- data.frame(
x = sample(seq(1, 20, by = 0.01), 1e5, replace = TRUE),
y = sample(seq(1, 20, by = 0.01), 1e5, replace = TRUE)
)
ui <- fluidPage(
tags$br(),
conditionalPanel(condition = 'output.test == null', tags$b("Generating plot...")),
conditionalPanel(condition = 'output.test != null', downloadButton('foo'), style = "display: none;"),
plotOutput("test")
)
server <- function(input, output, session) {
output$test <- renderPlot(ggplot(foo, aes(x, y)) + geom_point())
output$foo = downloadHandler(
filename = 'test.png',
content = function(file) {
showNotification(
ui = tags$b("Preparing download..."),
duration = NULL,
closeButton = TRUE,
id = "download_notification",
type = "message",
session = session
)
ggsave(file)
removeNotification(id = "download_notification", session = session)
}
)
}
shinyApp(ui, server)
This is my first Shiny App, so I'm sure it could be improved ;)
I think, that from the point of UX - it is better to do in the following way: "display a graph -> save the graph"
An addition:
So, I added a busy spinner, now an user of this app can know that this graph still rendering. You can use several styles, choose your favourite there:
library(shiny)
library(ggplot2)
library(shinybusy)
#your data
df <- data.frame(
x <- sample(seq(1, 20, by = 0.01), 5*1e5, replace = TRUE),
y <- sample(seq(1, 20, by = 0.01), 5*1e5, replace = TRUE)
)
#your plot
plot_df <- ggplot(df, aes(x, y)) + geom_point()
#my plot
my_plot <- ggplot(diamonds, aes(price, fill = cut)) +
geom_histogram(binwidth = 500)
ui <- fluidPage(
#our buttons
br(),
actionButton("button1", label = "View graph"),
br(),
br(),
plotOutput("button1"),
uiOutput("button2"),
add_busy_spinner(spin = "fading-circle")
)
server <- function(input, output) {
observeEvent(input$button1, {
output$button1 <- renderPlot(my_plot)
output$button2 <- renderUI({
br()
downloadButton("button3")
})
})
output$button3 <- downloadHandler(
filename <- 'test.png',
content <- function(file){
ggsave(file)
}
)
}
shinyApp(ui, server)
I seek a method in R shiny that I can include inside a render or an observe to check if a certain value has changed.
For example :
library(shiny)
library(shinycssloaders)
ui <- fluidPage(
fluidRow(
column(5,
imageOutput("image") %>% withSpinner()
),
actionButton("button", "redo")
)
)
server <- function(input, output, session) {
data = reactiveVal(data.frame(
gp = factor(rep(letters[1:3], each = 10)),
y = rnorm(30)
))
getWidth = function(image)
paste0(session$clientData[[paste0("output_", image, "_width")]], "px")
output$image = renderImage({
input$button
outfile = tempfile(fileext = ".png")
p = ggplot(data(), aes(gp, y)) +
geom_point()
Sys.sleep(2) # to symbolise a plot which is very slow to appear
ggsave(filename = outfile, p)
return(list(src = outfile, width = getWidth("image")))
}, deleteFile = F)
}
shinyApp(ui, server)
Here just when I resize the window, the image is resaved, I do not want that. But I want that code to save the file if and only if data() or input$button is changed.
The only solution I see so far is to copy the data in an independent variable and to check if the value has changed. If the data change, save the new plot, change the value of the independent variable.
But I am not convinced that is it a good solution because the value data will be copied twice. For this dataset it not very severe, but for a dataset with millions lines the strain is harder. Or a graph that takes more than 10 seconds to save.
Thank you,
My suggestion would be
Use renderPlot instead of renderImage
Create the plot in a reactive expression
Save only when the plot changes (now it only reacts to data changes not to resizes) or the button is pressed, by using an observeEvent with those two events as triggers.
Find a working example below. If you want to change the size of the saved plot do it in the ggsave.
library(shiny)
library(shinycssloaders)
library(tidyverse)
ui <- fluidPage(
fluidRow(
column(5,
imageOutput("image") %>% withSpinner()
),
actionButton("button", "redo")
)
)
server <- function(input, output, session) {
data = reactiveVal(data.frame(
gp = factor(rep(letters[1:3], each = 10)),
y = rnorm(30)
))
p <- reactive({ggplot(data(), aes(gp, y)) +
geom_point()
})
observeEvent(c(p(), input$button), {
outfile = tempfile(fileext = ".png")
ggsave(filename = outfile, p())
})
output$image = renderPlot({
Sys.sleep(2) # to symbolise a plot which is very slow to appear
p()
})
}
shinyApp(ui, server)
I have created a Shiny app, which involves the user importing data, manipulating it, creating a datatable and associated plot.
I'd like to build in a downloadable report using Rmarkdown (which I've only just started to use). However, i am unsure how to print the datatables and plots generated in R, in the Rmarkdown script, without copying the whole R code from the Shiny app. It is quite a long piece of code, so i'd like to be able to use the outputs directly.
As an example, I've copied the following app to demonstrate my point.
library(shiny)
ui <- fluidPage(
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
mainPanel(
plotOutput("distPlot"),
dataTableOutput("summary_table"),
downloadButton("report", "Generate report")
)
)
)
server <- function(input, output) {
output$distPlot <- renderPlot({
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
output$summary_table <- renderDataTable({
x <- faithful
head(x,5)
})
output$report <- downloadHandler(
filename = "report.html",
content = function(file) {
tempReport <- file.path(tempdir(), "report.Rmd")
file.copy("report.Rmd", tempReport, overwrite = TRUE)
rmarkdown::render(tempReport, output_file = file,
envir = new.env(parent = globalenv())
)
}
)
}
shinyApp(ui = ui, server = server)
I would like to access the plot and data table in my downloadable R markdown file.
my approach, using app.R and test.Rmd
in app.R
create a reactive variable, containing the plot/chart (replace with your own plot).
chart1 <- reactive({
ggmap(get_map(location = "Netherlands",
zoom = 7,
scale = 2,
color="bw",
language = "nl-NL"))
})
then, call the markdown:
output$report <- downloadHandler(
filename = "test.pdf",
content = function(file) {
src <- normalizePath('test.Rmd')
#switch to system tempdir
#just in case the app doesn't have write persission in the current folder
owd <- setwd(tempdir())
on.exit(setwd(owd))
file.copy(src, 'test.Rmd', overwrite = TRUE)
out <- render("test.Rmd", "pdf_document" )
file.rename(out, file)
}
)
in the .Rmd file, you then can call on the chart:
plot(chart1())
Note the () after chart1!!!
Follow the same structure for tables, an all other objects you wish to include in your markdown..
I am going to build a web page that clusters iris data based on the number of clusters the user enters. It uses K means algorithm to cluster the data and shows a plot of clustered data.
It does not work and I do not know why. I started from this link:
http://rstudio.github.io/shiny/tutorial/#sending-images
Here are my files:
ui.R
library(shiny)
shinyUI(pageWithSidebar(
headerPanel("Clustering iris Data"),
sidebarPanel(
sliderInput("k", "Number of clusters:",
min = 1, max = 5, value = 3)
),
mainPanel(
# Use imageOutput to place the image on the page
imageOutput("myImage")
)
))
and server.R
library(shiny)
library(caret)
library(ggplot2)
data(iris)
inTrain <- createDataPartition(y=iris$Species, p=0.7, list=FALSE)
training <- iris[inTrain,]
testing <- iris[-inTrain,]
shinyServer(function(input, output, session) {
output$myImage <- renderImage({
# A temp file to save the output.
# This file will be removed later by renderImage
outfile <- tempfile(fileext='.png')
kMeans1 <- kmeans(subset(training,select=-c(Species)),centers=input$k)
training$clusters <- as.factor(kMeans1$cluster)
# Generate the PNG
png(outfile, width=400, height=600)
qplot(Petal.Width,Petal.Length,colour=clusters,data=training,main="iris Data Clusters")
print(qplot)
#plot(training$Petal.Width,training$Petal.Length,colour=clusters,data=training,main="iris Data Clusters")
#hist(rnorm(input$k), main="Generated in renderImage()")
#myImage
dev.off()
# Return a list containing the filename
list(src = outfile,
contentType = 'image/png',
width = 400,
height = 600,
alt = "This is alternate text")
}, deleteFile = TRUE)
})
I think you just have to change
qplot(Petal.Width,Petal.Length,colour=clusters,data=training,main="iris Data Clusters")
print(qplot)
to something like this:
qP <- qplot(
Petal.Width,Petal.Length,
colour=clusters,data=training,
main="iris Data Clusters")
print(qP)
Because your call to qplot() was not actually creating an object; which is why print(qplot) was printing the function definition of qplot in the console.