Animation/transition for Shiny conditionalPanel

Viewed 641

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

1 Answers

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)

enter image description here


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)

enter image description here


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)

enter image description here


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)

enter image description here


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)

enter image description here

Related