Downloading Png from Shiny (R)

Downloading png from Shiny (R)

A workaround for this strange scenario was discussed on the shiny-discuss google group. What you can do is simply change your reactive plotInput statement into a normal function. Not sure why downloadHandler doesn't play nice with reactive objects.

# change
plotInput <- reactive({...})

# into this
plotInput <- function(){...}

You can also remove the print statement in the downloadHandler call:

output$downloadPlot <- downloadHandler(
filename = "Shinyplot.png",
content = function(file) {
png(file)
plotInput()
dev.off()
})

Downloading zipped PNGs in R Shiny

I figured out a way to make it work by using tar rather than zip. I am going to play around with it some more, but this seems to work on the Shiny Server.

 output$imgs <- downloadHandler(
filename = "DownloadPNGs.tar",

content = function(file){

tmpdir <- tempdir()
setwd(tempdir())
count<-0
for (i in imgFiles$imgs){
path <-paste0(imgFiles$names[count+1],".png")
download.file(i,path,mode="wb")
Sys.sleep(.69)
count=count+1
}
tar(tarfile = file,files=tmpdir)
}
)

Unable to download a .png file from shiny

This seems to be an issue of scope. Your code does work if you put the download button in the sidebar panel, if you remove the tabsetPanel, or if you put the download button in the same tabPanel. The last solution is shown below:

mainPanel(
tabsetPanel( type = "tabs", #Open panel
tabPanel("Distributions",
plotOutput("hist.plot"),
downloadButton('downloadhist', 'Download Plot')
)
)
) # close mainPanel

Downloading png from Shiny (R) pt. 2

This is highly related to Save plots made in a shiny app

Try adding print(plotInput2()) to downloadHandler instead of plotInput2()

Reason for the need of print() can be found from: http://cran.r-project.org/doc/FAQ/R-FAQ.html#Why-do-lattice_002ftrellis-graphics-not-work_003f

It seems that ggplot doesn't draw the plot but only creates a graph object.

Is it possible to change downloading behavior for large PNG files?

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)

result

Save reactive plot to temp directory as png from shiny app

There is no need to save a temporary png file. We can use recordPlot instead:

library(shiny)
library(datasets)

writeLines(con = "report.Rmd", text = "---
title: 'Plot report'
output: html_document
params:
plot_object: NA
---

```{r plotout, echo=FALSE, message=FALSE, out.width='100%'}
params$plot_object
```")

ui = fluidPage(
plotOutput("plot1"),
downloadButton("report_button", "Generate report")
)

server = function(input, output, session) {
reactivePlot1 <- reactive({
plot(mtcars$wt, mtcars$mpg)
recordPlot()
})

output$plot1 <- renderPlot({
reactivePlot1()
})

output$report_button <- downloadHandler(
filename = "report.html",
content = function(file) {
tempReport <- tempfile(fileext = ".Rmd") # make sure to avoid conflicts with other shiny sessions if more params are used
file.copy("report.Rmd", tempReport, overwrite = TRUE)
rmarkdown::render(tempReport, output_format = "html_document", output_file = file, output_options = list(self_contained = TRUE),
params = list(plot_object = reactivePlot1())
)
}
)
}

shinyApp(ui, server)

Please see my related answer here.


After OPs update - using dummy data:

app.R:

library(shiny)
library(radarchart)

scores <- data.frame("Label"=c("Communicator", "Data Wangler", "Programmer",
"Technologist", "Modeller", "Visualizer"),
"Rich" = c(9, 7, 4, 5, 3, 7),
"Andy" = c(7, 6, 6, 2, 6, 9),
"Aimee" = c(6, 5, 8, 4, 7, 6))

ui = fluidPage(
chartJSRadarOutput("radar", width = "450", height = "300"),
downloadButton("report", "Generate report")
)

server = function(input, output, session) {
reactiveRadar <- reactive({
chartJSRadar(scores, maxScale = 10, showToolTipLabel=TRUE)
})

# plot: Radarplot ------
output$radar <- renderChartJSRadar({
reactiveRadar()
})

# create markdown report with radar plot ----------------------------------

output$report <- downloadHandler(
filename = "report.html",
content = function(file) {
td <- tempdir()
tempReport <- file.path(td, "report.Rmd")
# tempLogo <- file.path(td, "logo.png")
file.copy("report.Rmd", tempReport, overwrite = TRUE)
# file.copy("logo.png", tempLogo, overwrite = TRUE)

params <- list(scores = "Test", plot_object = reactiveRadar()) # scores = PSA_13()[,c(1,2,6)]

rmarkdown::render(tempReport, output_file = file,
params = params,
envir = new.env(parent = globalenv())
)
}
)
}

shinyApp(ui, server)

report.Rmd:

---
geometry: margin=20truemm
fontfamily: mathpazo
fontsize: 11pt
documentclass: article
classoption: a4paper
urlcolor: blue
output:
html_document
header-includes:
- \usepackage{fancyhdr}
- \pagestyle{fancy}
# - \rhead{\includegraphics[width = .05\textwidth]{logo.png}}
params:
scores: NA
plot_object: NA
---
\pagenumbering{gobble}

```{r setup, include=FALSE}
knitr::opts_chunk$set()
library(draw)
```

```{r rectangle, echo=FALSE}
drawBox(x =1.3, y = 3.7, width = 2.5, height = 1)
```

\vspace{-80truemm}

```{r plotout, echo=FALSE, message=FALSE, out.width='100%'}
params$plot_object
```

Error with downloadHandler downloading an image with R Shiny

outfile is defined inside the renderImage, and then it does not exist in the downloadHandler. So define it at the root of your server function:

shinyServer(function(input, output) {

outfile <- tempfile(fileext = '.png')

output$myImage <- renderImage({
......

R Shiny: Exported PNG Resolution is Different when Running App Local vs. Deployed

Please use the following to check if the ragg output remains identical on your system and shinyapps.io:

##### Load R packages #####
library("shiny")
library("shinythemes")
library("ragg")

createPNG <- function(text_input, res, type){
outfile <- tempfile(fileext = paste0("_", gsub(" ","_", gsub(":",".", Sys.time())), "_", type, ".png"))

if(type == "ragg"){
agg_png(outfile, width = 1500, height = 1000, res = res)
} else {
png(outfile,
width = 1500,
height = 1000,
res = res, type = type)
}

par(mar = c(0, 0, 0, 0))
par(bg = "green")

N <- 5000
x <- runif(N)
y <- runif(N)

plot(x, y, type = "l", xlim = c(0.1, 0.9), ylim = c(0.1, 0.9))
points(0.5, 0.5, col = "green", cex = 1700, pch = 16)
text(0.5, 0.575, text_input, cex = 50)
invisible(dev.off())
outfile
}

##### Define UI #####
ui <- fluidPage(theme = shinytheme("cerulean"),
path_now,
mainPanel(tags$h1("My Input"),
textInput("some_text", "Insert Some Text", "Some Text"),
verbatimTextOutput("pngPaths"),
numericInput("resolution", "resolution", value = 10, min = 1, max = 20),
actionButton("do", "Run")
))

##### Define server function #####
server <- function(input, output, session) {

pngPaths <- reactiveVal(NULL)

observeEvent(input$do, {
cairoPath <- createPNG(input$some_text, input$resolution, "cairo")
windowsPath <- createPNG(input$some_text, input$resolution, "windows")
raggPath <- createPNG(input$some_text, input$resolution, "ragg")

pngPaths(list(cairoPath, windowsPath, raggPath))

if(Sys.info()["sysname"] == "Windows"){
shell.exec(dirname(cairoPath))
}
})

output$pngPaths <- renderPrint(req(pngPaths()))
}

##### Create Shiny object #####
shinyApp(ui = ui, server = server)

Here a related post can be found.

How to download plots made in a shiny app(in a jpeg /png format )

I would suggest you to use Highcharter package. This way you don't need to create a download button, because the chart has options to download in several extensions. Here I give you an example of an histogram, choosing to export in PNG, SVG, JPEG or PDF.

## Export charts with Highcharter in Shiny

# Load package
library('highcharter')

# UI side
highchartOutput('plot')

# Server side
output$plot <- renderHighchart({

# Define your data, here I am using Iris dataset as example
DT <- iris$Sepal.Length

# Define export options
export <- list(
list(
text = "PNG",
onclick = JS("function () {
this.exportChart({ type: 'image/png' }); }")
),
list(
text = "JPEG",
onclick = JS("function () {
this.exportChart({ type: 'image/jpeg' }); }")
),
list(
text = "SVG",
onclick = JS("function () {
this.exportChart({ type: 'image/svg+xml' }); }")
),
list(
text = "PDF",
onclick = JS("function () {
this.exportChart({ type: 'application/pdf' }); }")
)
)

# Plot histogram
hchart(DT,
type = "area",
name = colnames(iris[1])
) %>%
hc_exporting(
enabled = TRUE,
formAttributes = list(target = "_blank"),
buttons = list(contextButton = list(
text = "Export",
theme = list(fill = "transparent"),
menuItems = export
))
)
})

The output should be something like this:
Sample Image

Hope this helps.

Wlademir.



Related Topics



Leave a reply



Submit