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)
```
Related
I am building a shiny dashboard and plan to use SliderInput to animate a set of exisiting pngs. To do so, in the UI I have:
tabItem(tabName = 'Image',
fluidRow(
box(title = "", status="primary",solidHeader = F,width = 9,
uiOutput("animate_img"),
tags$style(type="text/css", "recalculating { opacity: 1.0 !important; }") # NOT WORKING
),
box(
title = "Options", status="info",solidHeader = TRUE,width = 3,
sliderInput("dates_img",
"Dates:",
min = as.Date("2017-01-01","%Y-%m-%d"),
max = as.Date("2018-12-31","%Y-%m-%d"),
value=as.Date("2017-01-01"),
timeFormat="%Y-%m-%d",
animate=animationOptions(interval=1000, loop = TRUE))
)
)
)
and in the server I have:
output$animate_img <- renderUI({
y <- year(input$dates_img)
d <- yday(input$dates_img)
filename <- sprintf("img_%d_%d.png",d,y)
tags$img(src = filename, width="100%")
})
While this code works to display the images, when I use the "play" button on the sliderInput to animate the images, there is flickering as each image loads. I would like to have a smooth animation if possible.
As suggested here, I have tried adding tags$style(type="text/css", "recalculating { opacity: 1.0 !important; }") to the UI, but this does not work.
Any recommendations for how to prevent the images from flickering as the animation plays? Thank you!
I was able to get it to work without any flickering by simply adjusting how the CSS is included in the rendered HTML. I used shinyjs::inlineCSS in my example, but the same could be done via sourcing an external stylesheet .css file with tags$head and tags$script or via includeCSS, etc. The key is to have the CSS loaded into the full HTML document's head (can verify via browser DevTools):
library(shiny)
library(shinydashboard)
library(shinyjs)
library(lubridate)
ui <- fluidPage(
shinyjs::inlineCSS(
"recalculating { opacity: 1.0 !important; }"
),
fluidRow(
box(title = "",
status = "primary",
solidHeader = F,
width = 9,
uiOutput("animate_img")
),
box(
title = "Options",
status = "info",
solidHeader = TRUE,
width = 3,
sliderInput("dates_img",
"Dates:",
min = as.Date("2017-01-01","%Y-%m-%d"),
max = as.Date("2018-12-31","%Y-%m-%d"),
value = as.Date("2017-01-01"),
timeFormat = "%Y-%m-%d",
animate = animationOptions(interval = 1000, loop = TRUE))
)
)
)
server <- function(input, output) {
output$animate_img <- renderUI({
y <- year(input$dates_img)
d <- yday(input$dates_img)
filename <- sprintf("img_%d_%d.png",d,y)
tags$img(src = filename, width="100%")
})
}
shinyApp(ui = ui, server = server)
Just make sure that your image files are placed directly in the www folder and it should work.
Thanks,
Jimmy
I am trying to create a Shiny app which
a) prompts user to upload a file which contains numeric data,
b) reads the file and assigns the data points to different variables,
c) calculates new variables from the captured variables
d) display a 'Gauge' using the calculated variables
The code successfully executes but the Gauge chart is not rendered properly. There is no error or warning message either. Instead, I am getting the following message:
"Input to asJSON(keep_vec_names=TRUE) is a named vector. In a future version of jsonlite, this option will not be supported, and named vectors will be translated into arrays instead of objects. If you want JSON object output, please use a named list instead. See ?toJSON."
And instead of the gauge output I am getting that tiny spec in the middle, as seen in the attached image.
The entire code is fairly long, hence providing just the relevant snippets of code.
Would really appreciate if you can help fix this.
library(shiny)
library(flexdashboard)
ui <- fluidPage(
tabPanel("Sensitivity Analysis",
sidebarLayout(
sidebarPanel(
uiOutput("Sensitivity_Analysis")
),
mainPanel(
gaugeOutput("sensitivity", width = "600px", height = "600px")
)
)
),
server <- function (input, output)
{
output$input_financials=renderUI({
fluidRow(fileInput("file1", "Choose CSV File",multiple = FALSE,accept = c("text/csv","text/comma-separated-values,text/plain",".csv")),
actionButton("process","Process"))})
data_input=reactiveValues()
observeEvent(input$process,{
file_input <- input$file1
if (is.null(file_input)) {
return(NULL)}
## File is read and all the inputs are assigned to variables
....
## Output for Gauge begins
output$sensitivity <- flexdashboard::renderGauge({
gauge_limit <- data_input$wc_value
data_input$cash_rel_dpo <- ## Formula for cash_del_dpo
data_input$cash_rel_dro <- ## Formula for cash_del_dro
data_input$cash_rel_dio <- ## Formula for cash_del_dio
data_input$wc_predicted_value <- (data_input$wc_predicted_value - data_input$cash_rel_dpo - data_input$cash_rel_dro - data_input$cash_rel_dio)
gauge(data_input$wc_predicted_value, min = 0, max = gauge_limit,
gaugeSectors(success = c(0, 10000),
warning = c(10001, 50000),
danger = c(50001, 1000000000))
)
})
shinyApp(ui = ui, server = server)
Screenshot of the output generated upon executing the code
There's a similar gauge in package billboarder, try this example:
library(shiny)
library(billboarder)
ui <- fluidPage(
tabPanel(
title = "Sensitivity Analysis",
sidebarLayout(
sidebarPanel(
fileInput("file1", "Choose CSV File",
multiple = FALSE,
accept = c("text/csv","text/comma-separated-values,text/plain",".csv")),
actionButton(inputId = "process", label = "Process (click here to refresh the gauge)")
),
mainPanel(
billboarderOutput("sensitivity", width = "400px", height = "400px")
)
)
)
)
server <- function (input, output) {
data_input <- reactiveValues(x = 0)
observeEvent(input$process, {
data_input$x <- sample.int(1e5, size = 1)
}, ignoreInit = TRUE)
## Output for Gauge begins
output$sensitivity <- renderBillboarder({
billboarder() %>%
bb_gaugechart(
value = data_input$x,
name = "Predicted value",
steps = c(1e4, 5e4, 1e5),
steps_color = rev(c("#FF0000","#F6C600", "#60B044"))
) %>%
bb_gauge(
min = 0, max = 1e5,
units = "",
label = list(
format = htmlwidgets::JS("function(value, ratio) {return d3.format(',')(value);}") # format value with thousand separator
),
width = 80
)
})
}
shinyApp(ui = ui, server = server)
I'm trying to shift elements out of the way for rendered images not to overlap with anything (trying to do it dynamically so that any size page fits and just pushed everything out of the way sort of)... Pretty new to this whole thing. Thank you in advance!
library(shiny)
library(webshot)
ui <- fluidPage(
titlePanel(
fluidRow ( align = "center", h3("Screens"))
),
sidebarLayout(
#Side panel lay out to include variant, gene and disease info relevant to interpretation
sidebarPanel(width=3,
h5("Screens")),
mainPanel(
textInput("screen1", h5("Screenshot1"),
value = "http://example.com/", width = "100%", placeholder = NULL),
imageOutput("screen1"),
textInput("screen2", h5("Screenshot2"),
value = "http://example.com/", width = "100%", placeholder = NULL),
imageOutput("screen2")
)))
server <- function(input, output, session) {
output$screen1 <- renderImage({
webshot(input$screen1, zoom = 1,
file = "screen1.png")
list(src = "screen1.png",
contentType = 'image/png')
})
output$screen2 <- renderImage({
webshot(input$screen2 , zoom = 1,
file = "screen2.png")
list(src = "screen2.png",
contentType = 'image/png')
})
}
shinyApp(ui = ui, server = server)
Aim: divide the available tabPanel into equal cells and display images in cells with Shiny, the number of cells in horizontal space (columns) can be inputted and changed by selectInput. As the number of columns changes, so does the sizes of grids and images.
Problem: how to change the (horizontal and vertical) spacing between cells? how to resize images to fit cells? how to load and display hundreds of images more efficiently with Shiny? Thank you in advance!
Below is the code adapted from this and this, which can display images, but has some problems mentioned before.
rm(list = ls())
library(shiny)
img_dirs <- list.files("www/image", full.names = TRUE)
# img_dirs <- img_dirs[1:10]
img_num <- length(img_dirs)
render_image <- function(img_num, input, output) {
for (i in seq.int(img_num)) {
local({
ii <- i
output[[paste0("img_", ii)]] <- renderImage({
list(src = img_dirs[ii],
contentType = 'image/jpg',
width = '50%',
height = 'auto',
alt = "Image failed to render")
}, deleteFile = FALSE)
})
}
}
ui <- shinyUI(
navbarPage(
theme = shinythemes::shinytheme("cerulean"),
title = "UU",
tabPanel('images',
sidebarPanel(
selectInput('col_num', 'Columns', c(1, 2, 3, 4, 6, 12), selected = 4)),
mainPanel(
uiOutput('myplots'))
)
)
)
server <- shinyServer(function(input, output) {
output$myplots <- renderUI({
## Construct imageOutputs
img_out_lst <- lapply(seq.int(img_num), function(i)
imageOutput(paste0('img_', i)))
fluidRow(
lapply(
split(img_out_lst, f = rep(c(1 : as.numeric(input$col_num)), length.out = length(img_out_lst))),
function(x) column(width = 12 / as.numeric(input$col_num), x, offset = 0, align="center",
style = "padding: 0px 0px; margin-top:-2em")) # fail to decrease spacing
)
})
observeEvent(img_num, render_image(img_num, input, output))
})
shinyApp(ui, server)
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
})