Animation/transition for Shiny conditionalPanel - r

Question

Shiny conditionalPanels just abruptly appear then disappear. Is there any way to make them slide or fade or otherwise gently transition?

Answer 1

Here is a way to fade the element when it is shown:
js <- "
$(document).ready(function(){
$('#plotContainer').on('show', function(event){
$(this).css('opacity', 0).animate({opacity: 1}, {duration: 1000});
});
});
"
ui <- fluidPage(
tags$head(tags$script(HTML(js))),
sidebarPanel(
actionButton("showplot", "Show")
),
mainPanel(
conditionalPanel(
condition = "input.showplot > 0",
id = "plotContainer",
plotOutput("plot")
)
)
)
server <- function(input, output) {
x <- rnorm(100)
y <- rnorm(100)
output$plot <- renderPlot({
plot(x, y)
})
}
shinyApp(ui, server)
EDIT
And also an effect on the hide event:
js <- "
$(document).ready(function(){
$('#plotContainer').on('show', function(){
$(this).css('opacity', 0).animate({opacity: 1}, {duration: 1000});
}).on('hide', function(){
var $this = $(this);
setTimeout(function(){
$this.show().hide(1000);
})
});
});
"
ui <- fluidPage(
tags$head(tags$script(HTML(js))),
sidebarPanel(
actionButton("showplot", "Show/Hide")
),
mainPanel(
conditionalPanel(
condition = "input.showplot % 2 == 1",
id = "plotContainer",
plotOutput("plot")
)
)
)
server <- function(input, output) {
x <- rnorm(100)
y <- rnorm(100)
output$plot <- renderPlot({
plot(x, y)
})
}
shinyApp(ui, server)
EDIT
Funny effects with the libraries Animate.css and jQuery-animateCSS:
js <- "
$(document).ready(function(){
$('#plotContainer').on('show', function(){
var $this = $(this);
$this.css('opacity', 0).
animate({opacity: 1}, 500, function(){
$this.animateCSS('jello', {
delay: 0,
duration: 2000
});
});
}).on('hide', function(){
var $this = $(this);
setTimeout(function(){
$this.show().animateCSS('heartBeat', {
delay: 0,
duration: 2000,
callback: function(){$this.hide(500);}
});
}, 0);
});
});
"
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(HTML(js))
),
sidebarPanel(
actionButton("showplot", "Show/Hide")
),
mainPanel(
conditionalPanel(
condition = "input.showplot % 2 == 1",
id = "plotContainer",
plotOutput("plot")
)
)
)
server <- function(input, output) {
x <- rnorm(100)
y <- rnorm(100)
output$plot <- renderPlot({
plot(x, y)
})
}
shinyApp(ui, server)
EDIT
I've done some convenient R functions to bind these animations in a Shiny app. Here is the code:
library(shiny)
animateCSS <- function(effect, delay = 0, duration = 500, then = NULL){
effect <- match.arg(effect, 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"
))
js <- paste(
" $this.animateCSS('%s', {",
" delay: %d,",
" duration: %d,",
" callback: function(){",
" %s",
" }",
" });",
sep = "\n"
)
sprintf(js, effect, delay, duration, ifelse(is.null(then), "", then))
}
onShowJS <- function(animation, fadeDuration){
sprintf(paste(
"$('#%%s>div').on('show', function(){",
" var $this = $(this);",
" $this.css('opacity', 0).animate({opacity: 1}, %d, function(){",
animation,
" });",
"});",
sep = "\n"
), fadeDuration)
}
onHideJS <- function(animation, fadeDuration){
paste(
"$('#%s>div').on('hide', function(){",
" var $this = $(this);",
" setTimeout(function(){",
sub(
"^(\\s.*?\\$this\\.animateCSS)",
"$this.show().animateCSS",
sub(
"\\{\n \n \\}",
sprintf("{$this.hide(%d);}", fadeDuration),
animation
)
),
" }, 0);",
"});",
sep = "\n"
)
}
animatedConditionalPanel <-
function(condition, ..., onShow = NULL, fadeIn = 600, onHide = NULL, fadeOut = 400){
id <- paste0("animateCSS-", stringi::stri_rand_strings(1, 15))
jsShow <- ifelse(!is.null(onShow), sprintf(onShowJS(onShow, fadeIn), id), "")
jsHide <- ifelse(!is.null(onHide), sprintf(onHideJS(onHide, fadeOut), id), "")
script <- tags$script(HTML(paste(jsShow,jsHide,sep="\n")))
condPanel <- conditionalPanel(condition, ...)
tags$div(id=id, tagList(condPanel, script))
}
You have to use animateCSS and animatedConditionalPanel only. The animateCSS function defines an animation. You can chain the animations with the then argument. The animatedConditionalPanel functions replaces conditionalPanel. Here is an example:
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")
),
sidebarPanel(
actionButton("showplot", "Show/Hide")
),
mainPanel(
animatedConditionalPanel(
condition = "input.showplot % 2 == 0",
onShow = animateCSS("swing", duration = 1000, then = animateCSS("jello")),
fadeIn = 400,
onHide = animateCSS("pulse", then = animateCSS("bounce")),
plotOutput("plot")
)
)
)
server <- function(input, output) {
x <- rnorm(100)
y <- rnorm(100)
output$plot <- renderPlot({
plot(x, y)
})
}
shinyApp(ui, server)
UPDATE JUNE 2022
These animations will be available in the next version of the shinyGizmo package.
library(shiny)
library(shinyGizmo)
ui <- fluidPage(
sidebarPanel(
actionButton("showplot", "Show/Hide")
),
mainPanel(
fluidRow(
column(
10,
conditionalJS(
plotOutput("plot"),
condition = "input.showplot % 2 === 1",
jsCalls$animateVisibility("jello", "tada", duration = 1500)
)
),
column(2)
)
)
)
server <- function(input, output) {
x <- rnorm(100)
y <- rnorm(100)
output[["plot"]] <- renderPlot({
plot(x, y, pch = 19)
})
}
shinyApp(ui, server)