Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Animation/transition for Shiny conditionalPanel

Tags:

r

shiny

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

like image 822
Steve Powell Avatar asked Dec 30 '22 23:12

Steve Powell


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

like image 84
Stéphane Laurent Avatar answered Jan 05 '23 15:01

Stéphane Laurent