Shiny conditionalPanels just abruptly appear then disappear. Is there any way to make them slide or fade or otherwise gently transition?
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)
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)
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)
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)
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)
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With