r - 在 Shiny 中对静态图像进行动画处理

标签 r shiny shinyanimate

我正在构建一个 Shiny 应用程序，它在多个选项卡上显示各种预渲染的 .png 和 .svg 图像，其中一些图像是通过不同类型的输入选择的。为了添加一些活力，我想向图像添加动画，每当显示图像时(选择其所在的选项卡或通过输入选择它时)都会播放动画。

我尝试过使用 shinyjs::show/hide 和 shinyjqui::jqui_effect，但这些函数似乎想要响应某些输入，例如按下按钮，而不是自动重复播放。

我成功地将下面的代码组合在一起，使用 shinyanimate 来实现所需的效果。然而，我的真实应用程序有更多的选项卡和图像，这种让每个动画对选项卡或输入中的任何更改使用react的方法似乎效率低下。有更好的方法吗？

(注意，我在这里只使用“bounceInLeft”效果，因为它使示例清晰，但我希望能够使用其他动画效果，例如“fadeIn”)。

enter image description here 

library(shiny)
library(shinyanimate)

# Define UI
ui <- fluidPage(

    withAnim(),
    
    tabsetPanel(id = "tabs",
        
        # Tab 1 ----
        tabPanel("Tab 1",
                 
                 fluidRow(
                     column(3,
                            
                            imageOutput("tab1_img1")
                            
                            ),
                     
                     column(3,
                            
                            imageOutput("tab1_img2")
                            
                            )
                     )
                 ),
        
       # Tab 2 ----
       tabPanel("Tab 2",
                
                selectInput("img_opts",
                            label = "Select image",
                            choices = c("img2", "img1")
                            ),
                
                imageOutput("tab2_imgs")
                
                )
    )
)

# Define server logic
server <- function(input, output) {

    # Tab 1 image 1
    output$tab1_img1 <- renderImage({
        
        list(src = file.path("images/img1.png"), width = "95%")
        
        }, deleteFile = FALSE)
    
    # Tab 1 image 1 animation
    observeEvent(input$tabs,
                 
                 startAnim(session = getDefaultReactiveDomain(), "tab1_img1", "bounceInLeft")
                 
                 )
    
    # Tab 1 image 2
    output$tab1_img2 <- renderImage({
        
        list(src = file.path("images/img2.png"), width = "95%")
        
        }, deleteFile = FALSE)
    
    # Tab 1 image 2 animation
    observeEvent(input$tabs,
                 
                 startAnim(session = getDefaultReactiveDomain(), "tab1_img2", "bounceInLeft")
                 
                 )
    
    # Tab 2 images
    output$tab2_imgs <- renderImage({
        
        list(src = file.path(paste0("images/", input$img_opts, ".png")), width = "25%")
        
        }, deleteFile = FALSE)
    
    # Tab 2 animation
    observeEvent(c(input$tabs, input$img_opts),
                 
                 startAnim(session = getDefaultReactiveDomain(), "tab2_imgs", "bounceInLeft")
                 
                 )
}

# Run the application 
shinyApp(ui = ui, server = server)

最佳答案

仅使用一个观察者即可获得相同的结果:

tabsetPanel(id = "tabs",
            
            # Tab 1 ----
            tabPanel("Tab 1",
                     
                     imageOutput("tab1_img"),
                     value = "tab1_img"
                     
            ),
            
            # Tab 2 ----
            tabPanel("Tab 2",
                     
                     selectInput("img_opts",
                                 label = "Select image",
                                 choices = c("img2", "img1")
                     ),
                     
                     imageOutput("tab2_img"),
                     value = "tab2_img"
                     
            )
)

observeEvent(c(input$tabs, input$img_opts), {
  
  startAnim(session = getDefaultReactiveDomain(), input$tabs, "bounceInLeft")
  
})

编辑:使用shinyjqui

library(shiny)
library(shinyjqui)

ui <- fluidPage(
  
  tabsetPanel(
    id = "tabs",
    # Tab 1 ----
    tabPanel(
      "Tab 1",
      fluidRow(
        column(3,
               imageOutput("tab1_img1")
        ),
        column(3,
               imageOutput("tab1_img2")
        )
      )
    ),
    # Tab 2 ----
    tabPanel(
      "Tab 2",
      selectInput("img_opts",
                  label = "Select image",
                  choices = c("img3", "img4")
      ),
      imageOutput("tab2_imgs")
    )
  )
)


server <- function(input, output, session) {
  
  # Tab 1 image 1
  output$tab1_img1 <- renderImage({
    
    list(src = "www/img1.JPG", width = "300")
    
  }, deleteFile = FALSE)
  
  # Tab 1 image 2
  output$tab1_img2 <- renderImage({
    
    list(src = "www/img2.JPG", width = "300")
    
  }, deleteFile = FALSE)
  
  # Tab 2 images
  output$tab2_imgs <- renderImage({
    
    list(src = paste0("www/", input$img_opts, ".JPG"), width = "300")
    
  }, deleteFile = FALSE)
  
  # animate
  observeEvent(list(input$tabs, input$img_opts), {
    jqui_effect(
      paste0("div.tab-pane[data-value=\"", input$tabs, "\"] img"), 
      "shake", 
      options = list(direction = "right", distance = 50, times = 3),
      duration = 1500
    )
  }, ignoreInit = FALSE)
  
}


shinyApp(ui = ui, server = server)

enter image description here

编辑:更好的解决方案

这里是使用 JavaScript 库 jquery.animatecss 和 CSS 库 animate.css 的解决方案，这是 shinyanimate 使用的库。下面的应用程序需要互联网连接才能包含这些库(请参阅tags$head)；最好下载它们(然后将它们放入 www 子文件夹中)。

library(shiny)

js <- HTML(
  '$(document).on("shiny:connected", function() {',
  '  Shiny.addCustomMessageHandler("animate", function(tab) {',
  '    var $tab = $("div.tab-pane[data-value=\\\"" + tab + "\\\"]");',
  '    var $imgs = $tab.find(".shiny-image-output");',
  '    $imgs.animateCSS("bounceInLeft", {duration: 1500});',
  '  });',
  '});'
)


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(js)
  ),
  
  tabsetPanel(
    id = "tabs",
    # Tab 1 ----
    tabPanel(
      "Tab 1",
      fluidRow(
        column(3,
               imageOutput("tab1_img1")
        ),
        column(3,
               imageOutput("tab1_img2")
        )
      )
    ),
    # Tab 2 ----
    tabPanel(
      "Tab 2",
      selectInput("img_opts",
                  label = "Select image",
                  choices = c("img3", "img4")
      ),
      imageOutput("tab2_imgs")
    )
  )
)


server <- function(input, output, session) {
  
  # Tab 1 image 1
  output$tab1_img1 <- renderImage({
    
    list(src = "www/img1.JPG", width = "300")
    
  }, deleteFile = FALSE)
  
  # Tab 1 image 2
  output$tab1_img2 <- renderImage({
    
    list(src = "www/img2.JPG", width = "300")
    
  }, deleteFile = FALSE)
  
  # Tab 2 images
  output$tab2_imgs <- renderImage({
    
    list(src = paste0("www/", input$img_opts, ".JPG"), width = "300")
    
  }, deleteFile = FALSE)
  
  # animate
  observeEvent(list(input$tabs, input$img_opts), {
    session$sendCustomMessage("animate", input$tabs)
  }, ignoreInit = FALSE)
  
}

# Run the application 
shinyApp(ui = ui, server = server)

以下是可用效果的列表:

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"
  )

这些效果的演示现已推出 here .

除了 duration 选项之外，JavaScript 函数 animateCSS(在 js 中使用)也接受 delay > 选项，如果您想延迟动画。

您可以通过允许在 session$sendCustomMessage 中设置所需的效果及其选项来改进此解决方案:

js <- HTML(
  '$(document).on("shiny:connected", function() {',
  '  Shiny.addCustomMessageHandler("animate", function(tab_and_options) {',
  '    var tab = tab_and_options.tab;',
  '    var o = tab_and_options.options;',
  '    var $tab = $("div.tab-pane[data-value=\\\"" + tab + "\\\"]");',
  '    var $imgs = $tab.find(".shiny-image-output");',
  '    $imgs.animateCSS(o.effect, {duration: o.duration, delay: o.delay});',
  '  });',
  '});'
)

    session$sendCustomMessage("animate", list(
      tab = input$tabs,
      options = list(
        effect = "bounceInLeft",
        duration = 1000,
        delay = 100
      )
    ))

编辑

图像在动画开始前的一小段时间内可见。看来这段代码可以防止这个问题:

js <- HTML(
  '$(document).ready(function() {',
  '  $("a[data-toggle=tab]").on("hide.bs.tab", function(e) {',
  '    var tab = $(e.target).data("value");',
  '    var $tab = $("div.tab-pane[data-value=\\\"" + tab + "\\\"]");',
  '    $tab.find(".shiny-image-output").css("visibility", "hidden");',
  '  });',
  '});',
  '$(document).on("shiny:connected", function() {',
  '  Shiny.addCustomMessageHandler("animate", function(tab_and_options) {',
  '    var tab = tab_and_options.tab;',
  '    var o = tab_and_options.options;',
  '    var $tab = $("div.tab-pane[data-value=\\\"" + tab + "\\\"]");',
  '    var $imgs = $tab.find(".shiny-image-output");',
  '    $imgs.animateCSS(o.effect, {duration: o.duration, delay: o.delay});',
  '  });',
  '});'
)

关于r - 在 Shiny 中对静态图像进行动画处理，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/64068554/

上一篇：javascript - 如何模拟按住单击按钮类

下一篇：javascript - 如何获取 FaunaDB 中某个集合的所有文档？

相关文章：

r - 在R中对大型矩阵的每一行进行排序的最快方法

optimization - 避免 R 中的循环

r - 按使用的包搜索 R 文件

r - Shiny 模块内的可编辑 DT

r - 有没有办法在 Shiny 应用程序的 FluidRow 中动态插入/添加 UI

R Shiny 使第二个操作按钮 2 在单击操作按钮 1 后出现

r - 如何正确为 r 代码创建 exe

©2024 IT工具网  联系我们