Animating static images in Shiny - r

Question

I'm building a Shiny app that displays various pre-rendered .png and .svg images across multiple tabs, with some of the images being chosen through different types of input. To add some pizzazz, I'd like to add animations to the images that play whenever an image is displayed, either when the tab that it's on is selected or when it is chosen through an input.
I've tried using shinyjs::show/hide and shinyjqui::jqui_effect, but those functions seem to want to respond to some input, like a button press, rather than playing automatically and repeatedly.
I've managed to put together the code below that uses shinyanimate to achieve the desired effect. However, my real app has many more tabs and images, and this method of having every animation react to any changes in the tabs or inputs seems inefficient. Is there a better way of doing this?
(N.B. I'm only using the "bounceInLeft" effect here because it makes the example clear, but I'd like to be able to use other animation effects such as "fadeIn").
library(shiny)
library(shinyanimate)
# Define UI
ui <- fluidPage(
withAnim(),
tabsetPanel(id = "tabs",
# Tab 1 ----
tabPanel("Tab 1",
fluidRow(
column(3,
imageOutput("tab1_img1")
),
column(3,
imageOutput("tab1_img2")
)
)
),
# Tab 2 ----
tabPanel("Tab 2",
selectInput("img_opts",
label = "Select image",
choices = c("img2", "img1")
),
imageOutput("tab2_imgs")
)
)
)
# Define server logic
server <- function(input, output) {
# Tab 1 image 1
output$tab1_img1 <- renderImage({
list(src = file.path("images/img1.png"), width = "95%")
}, deleteFile = FALSE)
# Tab 1 image 1 animation
observeEvent(input$tabs,
startAnim(session = getDefaultReactiveDomain(), "tab1_img1", "bounceInLeft")
)
# Tab 1 image 2
output$tab1_img2 <- renderImage({
list(src = file.path("images/img2.png"), width = "95%")
}, deleteFile = FALSE)
# Tab 1 image 2 animation
observeEvent(input$tabs,
startAnim(session = getDefaultReactiveDomain(), "tab1_img2", "bounceInLeft")
)
# Tab 2 images
output$tab2_imgs <- renderImage({
list(src = file.path(paste0("images/", input$img_opts, ".png")), width = "25%")
}, deleteFile = FALSE)
# Tab 2 animation
observeEvent(c(input$tabs, input$img_opts),
startAnim(session = getDefaultReactiveDomain(), "tab2_imgs", "bounceInLeft")
)
}
# Run the application
shinyApp(ui = ui, server = server)

Answer 1

You can achieve the same result with only one observer:
tabsetPanel(id = "tabs",
# Tab 1 ----
tabPanel("Tab 1",
imageOutput("tab1_img"),
value = "tab1_img"
),
# Tab 2 ----
tabPanel("Tab 2",
selectInput("img_opts",
label = "Select image",
choices = c("img2", "img1")
),
imageOutput("tab2_img"),
value = "tab2_img"
)
)
observeEvent(c(input$tabs, input$img_opts), {
startAnim(session = getDefaultReactiveDomain(), input$tabs, "bounceInLeft")
})
EDIT: using shinyjqui
library(shiny)
library(shinyjqui)
ui <- fluidPage(
tabsetPanel(
id = "tabs",
# Tab 1 ----
tabPanel(
"Tab 1",
fluidRow(
column(3,
imageOutput("tab1_img1")
),
column(3,
imageOutput("tab1_img2")
)
)
),
# Tab 2 ----
tabPanel(
"Tab 2",
selectInput("img_opts",
label = "Select image",
choices = c("img3", "img4")
),
imageOutput("tab2_imgs")
)
)
)
server <- function(input, output, session) {
# Tab 1 image 1
output$tab1_img1 <- renderImage({
list(src = "www/img1.JPG", width = "300")
}, deleteFile = FALSE)
# Tab 1 image 2
output$tab1_img2 <- renderImage({
list(src = "www/img2.JPG", width = "300")
}, deleteFile = FALSE)
# Tab 2 images
output$tab2_imgs <- renderImage({
list(src = paste0("www/", input$img_opts, ".JPG"), width = "300")
}, deleteFile = FALSE)
# animate
observeEvent(list(input$tabs, input$img_opts), {
jqui_effect(
paste0("div.tab-pane[data-value=\"", input$tabs, "\"] img"),
"shake",
options = list(direction = "right", distance = 50, times = 3),
duration = 1500
)
}, ignoreInit = FALSE)
}
shinyApp(ui = ui, server = server)
EDIT: better solution
Here is a solution using the JavaScript library jquery.animatecss and the CSS library animate.css, which is the library used by shinyanimate. The app below requires an internet connection to include these libraries (see tags$head); it's better to download them (and then to put them in the www subfolder).
library(shiny)
js <- HTML(
'$(document).on("shiny:connected", function() {',
' Shiny.addCustomMessageHandler("animate", function(tab) {',
' var $tab = $("div.tab-pane[data-value=\\\"" + tab + "\\\"]");',
' var $imgs = $tab.find(".shiny-image-output");',
' $imgs.animateCSS("bounceInLeft", {duration: 1500});',
' });',
'});'
)
ui <- fluidPage(
tags$head(
tags$link(rel = "stylesheet", href = "https://cdnjs.cloudflare.com/ajax/libs/animate.css/4.1.0/animate.compat.min.css"),
tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/animateCSS/1.2.2/jquery.animatecss.min.js"),
tags$script(js)
),
tabsetPanel(
id = "tabs",
# Tab 1 ----
tabPanel(
"Tab 1",
fluidRow(
column(3,
imageOutput("tab1_img1")
),
column(3,
imageOutput("tab1_img2")
)
)
),
# Tab 2 ----
tabPanel(
"Tab 2",
selectInput("img_opts",
label = "Select image",
choices = c("img3", "img4")
),
imageOutput("tab2_imgs")
)
)
)
server <- function(input, output, session) {
# Tab 1 image 1
output$tab1_img1 <- renderImage({
list(src = "www/img1.JPG", width = "300")
}, deleteFile = FALSE)
# Tab 1 image 2
output$tab1_img2 <- renderImage({
list(src = "www/img2.JPG", width = "300")
}, deleteFile = FALSE)
# Tab 2 images
output$tab2_imgs <- renderImage({
list(src = paste0("www/", input$img_opts, ".JPG"), width = "300")
}, deleteFile = FALSE)
# animate
observeEvent(list(input$tabs, input$img_opts), {
session$sendCustomMessage("animate", input$tabs)
}, ignoreInit = FALSE)
}
# Run the application
shinyApp(ui = ui, server = server)
Here is the list of available effects:
c(
"bounce",
"flash",
"pulse",
"rubberBand",
"shakeX",
"shakeY",
"headShake",
"swing",
"tada",
"wobble",
"jello",
"heartBeat",
"backInDown",
"backInLeft",
"backInRight",
"backInUp",
"backOutDown",
"backOutLeft",
"backOutRight",
"backOutUp",
"bounceIn",
"bounceInDown",
"bounceInLeft",
"bounceInRight",
"bounceInUp",
"bounceOut",
"bounceOutDown",
"bounceOutLeft",
"bounceOutRight",
"bounceOutUp",
"fadeIn",
"fadeInDown",
"fadeInDownBig",
"fadeInLeft",
"fadeInLeftBig",
"fadeInRight",
"fadeInRightBig",
"fadeInUp",
"fadeInUpBig",
"fadeInTopLeft",
"fadeInTopRight",
"fadeInBottomLeft",
"fadeInBottomRight",
"fadeOut",
"fadeOutDown",
"fadeOutDownBig",
"fadeOutLeft",
"fadeOutLeftBig",
"fadeOutRight",
"fadeOutRightBig",
"fadeOutUp",
"fadeOutUpBig",
"fadeOutTopLeft",
"fadeOutTopRight",
"fadeOutBottomRight",
"fadeOutBottomLeft",
"flip",
"flipInX",
"flipInY",
"flipOutX",
"flipOutY",
"lightSpeedInRight",
"lightSpeedInLeft",
"lightSpeedOutRight",
"lightSpeedOutLeft",
"rotateIn",
"rotateInDownLeft",
"rotateInDownRight",
"rotateInUpLeft",
"rotateInUpRight",
"rotateOut",
"rotateOutDownLeft",
"rotateOutDownRight",
"rotateOutUpLeft",
"rotateOutUpRight",
"hinge",
"jackInTheBox",
"rollIn",
"rollOut",
"zoomIn",
"zoomInDown",
"zoomInLeft",
"zoomInRight",
"zoomInUp",
"zoomOut",
"zoomOutDown",
"zoomOutLeft",
"zoomOutRight",
"zoomOutUp",
"slideInDown",
"slideInLeft",
"slideInRight",
"slideInUp",
"slideOutDown",
"slideOutLeft",
"slideOutRight",
"slideOutUp"
)
A demo of these effects is available here.
In addition to the duration option, the JavaScript function animateCSS (used in js) also accepts a delay option, if you want to delay the animation.
You can improve this solution by allowing to set the desired effect and its options in session$sendCustomMessage:
js <- HTML(
'$(document).on("shiny:connected", function() {',
' Shiny.addCustomMessageHandler("animate", function(tab_and_options) {',
' var tab = tab_and_options.tab;',
' var o = tab_and_options.options;',
' var $tab = $("div.tab-pane[data-value=\\\"" + tab + "\\\"]");',
' var $imgs = $tab.find(".shiny-image-output");',
' $imgs.animateCSS(o.effect, {duration: o.duration, delay: o.delay});',
' });',
'});'
)
session$sendCustomMessage("animate", list(
tab = input$tabs,
options = list(
effect = "bounceInLeft",
duration = 1000,
delay = 100
)
))
EDIT
The images are visible during a very small moment before the animation starts. It seems that this code prevents this issue:
js <- HTML(
'$(document).ready(function() {',
' $("a[data-toggle=tab]").on("hide.bs.tab", function(e) {',
' var tab = $(e.target).data("value");',
' var $tab = $("div.tab-pane[data-value=\\\"" + tab + "\\\"]");',
' $tab.find(".shiny-image-output").css("visibility", "hidden");',
' });',
'});',
'$(document).on("shiny:connected", function() {',
' Shiny.addCustomMessageHandler("animate", function(tab_and_options) {',
' var tab = tab_and_options.tab;',
' var o = tab_and_options.options;',
' var $tab = $("div.tab-pane[data-value=\\\"" + tab + "\\\"]");',
' var $imgs = $tab.find(".shiny-image-output");',
' $imgs.animateCSS(o.effect, {duration: o.duration, delay: o.delay});',
' });',
'});'
)