Shiny conditionalPanel 的动画/过渡

Ste*_*ell 4 r shiny

闪亮的条件面板只是突然出现然后消失。有没有办法让它们滑动或褪色或以其他方式轻轻过渡?

Sté*_*ent 9

这是一种在显示元素时淡化元素的方法:

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)
Run Code Online (Sandbox Code Playgroud)

在此处输入图片说明


编辑

以及对隐藏事件的影响:

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)
Run Code Online (Sandbox Code Playgroud)

在此处输入图片说明


编辑

Animate.cssjQuery-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)
Run Code Online (Sandbox Code Playgroud)

在此处输入图片说明


编辑

我已经完成了一些方便的 R 函数来将这些动画绑定到一个 Shiny 应用程序中。这是代码:

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))
  }
Run Code Online (Sandbox Code Playgroud)

您必须使用animateCSSanimatedConditionalPanel仅。该animateCSS函数定义了一个动画。您可以使用then参数链接动画。该animatedConditionalPanel功能的内容替换conditionalPanel。下面是一个例子:

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)
Run Code Online (Sandbox Code Playgroud)

在此处输入图片说明