I would like to create a plot in Shiny that the user can then download as a pdf using a custom font specified as a user input.
To be specific, I would like to use a pdf function such as pdf("plot.pdf", width = 5, height = 5, family = font.family), where the value of font.family is specified by the user.
Here is a simple example below: If I run the example on my machine, it works fine. However, when it is hosted on the RStudio shiny servers, I receive an error saying that the specified font family cannot be found. I think the problem is that the fonts I want are not accessible on the RStudio shiny servers, but is there a way I can include them?
server.R
shinyServer(function(input, output) {
output$distPlot <- renderPlot({
plot(1, xlim = c(0, 1), ylim = c(0, 1))
text(.5, .5, "Custom Font!!"
})
output$downloadPlot <- downloadHandler(
filename = function() {paste('CustomFont.pdf')},
content = function(file){
font.family <- input$font.family
pdf(file, width = 11, height= 8.5, family = font.family)
plot(1, xlim = c(0, 1), ylim = c(0, 1))
text(.5, .5, fonts(), cex = 10)
dev.off()
}, contentType = "image/pdf"
)
})
ui.R
shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("font.family", "Choose Font",
choices = c("Helvetica Neue", "Times New Roman", "Arial")
),
downloadButton("downloadPlot", "Download Plot as PDF")
),
# Show a plot of the plot
mainPanel(
plotOutput("distPlot", width = "800px", height = "800px")
))))
I had a similar problem. To solve that, much of the renderPlot() functionality was recreated using renderImage(), as described in this Shiny tutorial article. Font rendering then worked as desired.
This is the code which solved that question; it might also solve this one.
ui.R amend to
mainPanel(
imageOutput("myImage")
)
server.R
shinyServer(function(input, output, session) {
# A dynamically-sized plot
output$myImage <- renderImage({
# Read myImage's width and height. These are reactive values, so this
# expression will re-run whenever they change.
width <- session$clientData$output_myImage_width
height <- session$clientData$output_myImage_height
# For high-res displays, this will be greater than 1
pixelratio <- session$clientData$pixelratio
# A temp file to save the output.
outfile <- tempfile(fileext='.png')
# Generate the image file
png(outfile, width=width*pixelratio, height=height*pixelratio,
res=72*pixelratio)
plot(rnorm(100), rnorm(100), family="serif")
dev.off()
# Return a list containing the filename
list(src = outfile,
width = width,
height = height,
alt = "This is alternate text")
}, deleteFile = TRUE) # delete the temp file when finished
})
Related
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 am developing a package in R and its plotting functions include a line with pdf() or png() to save the figure. However, when I tried to create a Shiny app from this package the plots did not appear on the app. I verified that the pdf() function prevents the plot from being displayed. Is there a way to show the plots without changing the whole package? I was thinking about saving the image and rendering it, but maybe there is a more efficient answer.
I created a sample code just to illustrates the problem. The test_plot function shows an example of the structure of the functions in my package.
test_plot <- function(){
data=head(mtcars, 30)
g1 <- ggplot(data, aes(x=wt, y=mpg)) +
geom_point() + # Show dots
geom_text(
label=rownames(data),
nudge_x = 0.25, nudge_y = 0.25,
check_overlap = T
)
pdf(file = 'test.pdf', width = 5, height = 5)
print(g1)
}
The renderPlot just calls the test_plot. If I remove the pdf() from the code the figure is displayed correctly.
server <- function(input, output) {
output$distPlot <- renderPlot({
test_plot()
})
}
Perhaps try separating the renderPlot() from the PNG file itself, and allow the user to download the PNG with a downloadHandler():
library(shiny)
library(tidyverse)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput(
inputId = "n", label = "Select rows",
min = 1, max = nrow(mtcars),
value = 20, round = TRUE
),
downloadButton(outputId = "download")),
# Show a plot of the generated distribution
mainPanel(plotOutput("plot"))
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
# render plot
plot_reactive <- reactive({
p <- head(mtcars, input$n) %>%
ggplot(aes(x = wt, y = mpg)) +
geom_point()
})
output$plot <- renderPlot(print(plot_reactive()))
# download plot
output$download <- downloadHandler(
filename = function(){ paste0(input$n, "_mtcars.png") },
content = function(file){ ggsave(file, plot_reactive()) }
)
}
# Run the application
shinyApp(ui = ui, server = server)
I have a problem regarding shiny and the use of sliders, when displaying chart_Series and coloured lines . When I am using the slider from the right side, the color is chosen appropriately (mainly red dots). When I use the slider on left side (e.g. looking at the latest data) the color is not chosen appropriately (should be green). I seek for help and I'm thankful for any advise!
require(quantmod)
require(shiny)
getSymbols("YHOO")
data <- YHOO
data <- data[1:100,]
col_function <- rep("red",50)
col_function <- c(col_function, rep("green",50))
plot <- {
date_range <- index(data)
if (interactive()) {
options(device.ask.default = FALSE)
# Define UI
ui <- fluidPage(
titlePanel("Time:"),
sidebarLayout(
# Sidebar with a slider input
wellPanel(
tags$style(type="text/css", '#leftSlide { width:200px; float:left;}'),
id = "leftSlide",
sliderInput("Range", "Choose Date Range:",
min = first(date_range), max = last(date_range), value = c(first(date_range),last(date_range)))
),
mainPanel(
plotOutput("Plot", width = "150%", height = "500px")
)
)
)
# Server logic
server <- function(input, output) {
output$range <- renderPrint({ input$slider2 })
output$Plot <- renderPlot({
x_ti2 <- xts(rep(1, NROW(data)), order.by = index(data))
x_ti2[1, ] <- 0.5
chart_Series(data)
add_TA(x_ti2, col = col_function, pch = 9, type = 'p', cex = .7)
# Another way below, but the color function is still not working
#chart_Series(data["2017"], TA = 'add_TA(x_ti, col = col_function, pch = 15, type = "p", cex = .7); add_TA(x_ti2, col = "orange", pch = 9, type = "p", cex = .7)')
zoom_Chart(paste(input$Range, collapse = "::"))
})
observe({
print(input$Range)
})
}
shinyApp(ui, server)
}
}
plot
So, I found a workaround for my own problem:
as far as i can tell, shiny will edit the data, but not the coloring-vector (in respective pretty logical...). Therefore you'll have to tell shiny to update the range of the coloring as well.
First of all i transformed the coloring result to an xps-object. Then i added the x_ti2-variable to the original data-matrix and defined a variable with the input$range for your the col_function. The variable needs to part of the Global environment (such that shiny can use it). I hope this will solve some issues, if someone has a similiar problem.
I don't get renderImage()to work with a .svg file.
My minimal example (adapted from the corresponding RStudio-tutorial):
ui.R
shinyUI(pageWithSidebar(
headerPanel("renderSVG example"),
sidebarPanel(
sliderInput("obs", "Number of observations:",
min = 0, max = 1000, value = 500),
actionButton("savePlot", "savePlot")
),
mainPanel(
# Use imageOutput to place the image on the page
imageOutput("plot"),
imageOutput("plot_as_svg")
)
))
server.R
require("ggplot2")
library(svglite)
shinyServer(function(input, output, session) {
## create plot with renderPlot()
output$plot<- renderPlot({
hist(rnorm(input$obs), main="Generated in renderPlot()")
})
## create .svg file of the plot and render it with renderImage()
output$plot_as_svg <- renderImage({
# A temp file to save the output.
# This file will be removed later by renderImage
outfile <- tempfile(fileext='.svg')
# Generate the svg
svglite(outfile, width=400, height=300)
hist(rnorm(input$obs), main="Generated in renderImage()")
dev.off()
# Return a list containing the filename
list(src = outfile,
contentType = 'text/svg+xml',
width = 400,
height = 300,
alt = "This is alternate text")
}, deleteFile = TRUE)
})
Any ideas where the problem is?
I struggled with this same issue, and there is nothing out on the web that I have found to address this problem which is frustrating. Here is the solution that worked for me:
ui.R:
shinyUI(pageWithSidebar(
headerPanel("renderSVG example"),
sidebarPanel(
sliderInput("obs", "Number of observations:",
min = 0, max = 1000, value = 500),
actionButton("savePlot", "savePlot")
),
mainPanel(
# Use imageOutput to place the image on the page
imageOutput("plot"),
imageOutput("plot_as_svg")
)
))
server.R:
require("ggplot2")
shinyServer(function(input, output, session) {
## create plot with renderPlot()
output$plot<- renderPlot({
hist(rnorm(input$obs), main="Generated in renderPlot()")
})
## create .svg file of the plot and render it with renderImage()
output$plot_as_svg <- renderImage({
width <- session$clientData$output_plot_width
height <- session$clientData$output_plot_height
mysvgwidth <- width/96
mysvgheight <- height/96
# A temp file to save the output.
# This file will be removed later by renderImage
outfile <- tempfile(fileext='.svg')
# Generate the svg
svg(outfile, width=mysvgwidth, height=mysvgheight)
hist(rnorm(input$obs), main="Generated in renderImage()")
dev.off()
# Return a list containing the filename
list(src = normalizePath(outfile),
contentType = 'image/svg+xml',
width = width,
height = height,
alt = "My Histogram")
})
})
Notice I did not use the svglite package, just the svg device from the grDevices (base) package. I also normalized the path in the source because I am on a Windows machine (I believe this will change my source from forward slashes to back slashes, but maybe someone will comment on that).
Also, I created four new variables to house the svg width and height and image width and height to still be fluid with the page. I'm sure there is an easier workaround than this, but this is what I found that worked.
Inspired by R_User123456789s solution (here) for base graphics above I got it the following way with ggplot2
ui.r
shinyUI(pageWithSidebar(
headerPanel("renderSVG example"),
sidebarPanel(
sliderInput("obs", "Number of observations:",
min = 0, max = 1000, value = 500)
),
mainPanel(
# Use imageOutput to place the image on the page
imageOutput("plot"),
imageOutput("plot_as_svg")
)
))
server.r
require("ggplot2")
shinyServer(function(input, output, session) {
## create plot with renderPlot()
output$plot<- renderPlot({
hist(rnorm(input$obs), main="Generated in renderPlot() as png")
})
## create .svg file of the plot and render it with renderImage()
output$plot_as_svg <- renderImage({
width <- session$clientData$output_plot_width
height <- session$clientData$output_plot_height
mysvgwidth <- width/96
mysvgheight <- height/96
# A temp file to save the output.
# This file will be removed later by renderImage
outfile <- tempfile(fileext='.svg')
# Generate the svg
#to see actually what will be plotted and compare
qplot(clarity, data=diamonds, fill=cut, geom="bar")
#save the plot in a variable image to be able to export to svg
image=qplot(clarity, data=diamonds[1:input$obs,], fill=cut, geom="bar", main = "ggplot as svg")
#This actually save the plot in a image
ggsave(file=outfile, plot=image, width=mysvgwidth, height=mysvgheight)
# Return a list containing the filename
list(src = normalizePath(outfile),
contentType = 'image/svg+xml',
width = width,
height = height,
alt = "My svg Histogram")
})
})
I have 4 png images that I want to use to create a little animation. I would like to be able to set the speed between the images, and to have play/pause, back, forward buttons. Is this possible?
I found the animation package, but I don't think is possible to use png instead of R graphs to create the animation.
The goal is to use this animation in a R shiny presentation. So, shiny could be an option.
Thanks!
My solution right now is to have many slides:
## figures/Timeline {.flexbox .vcenter}
## figures/Timeline {.flexbox .vcenter}
This is a solution using shiny:
## Test
```{r, echo=FALSE, message=F}
server <- shinyServer(function(input, output, session) {
# Send a pre-rendered image, and don't delete the image after sending it
output$preImage <- renderImage({
filename <- normalizePath(file.path('./figures/vertchart',
paste(input$n, '.png', sep = '')))
# Return a list containing the filename and alt text
list(src = filename,
alt = paste("Image number", input$n))
}, deleteFile = FALSE)
})
ui <- shinyUI(
fluidPage(
absolutePanel(
top = 0, right = 20, width = 200,
draggable = TRUE,
wellPanel(
sliderInput(
"n", "", min = 1, max = 5, value = 1, animate = animationOptions(interval =
1200)
)
),
style = "opacity: 0.99"
),
imageOutput("preImage", width = "100%"
)
))
shinyApp(ui = ui, server = server)
```