如何将自动播放按钮添加到闪亮的应用程序

Question

我正在编写一个 Shiny 应用程序，它加载一系列图像（即帧）并包含一个“自动播放”按钮来自动浏览所有图像。

这里是代码相关部分的 MRE 版本。自动播放按钮是作为 UI 对象间接生成的，因为它还涉及一个动态帧选择滑块。示例PNG文件可在here获取。

library(shiny)
ui <- fluidPage(
    sidebarPanel(uiOutput("play")), # autoplay button
    mainPanel(imageOutput("image_frame"))
)
server <- function(input, output) {
    frame <- reactiveValues(out=1, autoplay=FALSE)
    # Finding where the images are stored and what their names are ---
    image <- reactive({
        file_path <- "~" # Home folder on Linux
        file_list <- list.files(file_path, pattern="*.png")
        return(list(path=file_path, name=file_list))
    })
    # Determining which frame will be printed ------------------------
    tot_frames <- reactive(length(image()$name))
    output$play <- renderUI(actionButton("play", "Autoplay"))
    observeEvent(input$play, {
        frame$autoplay <- TRUE
        frame$out <- 1:tot_frames()
    })
    # Printing selected frame ----------------------------------------
    frame_path_to_print <- reactive({
        filename <- image()$name[frame$out]
        out <- paste0(image()$path, filename)
        return(out)
    })
    # This is how I intuitively think it should work, except it doesn't
    if (isolate(frame$autoplay)) {
        for (f in isolate(frame$out)) {
            output$image_frame <- list(
                src=paste0(image()$path, image()$name[f])
            )
            Sys.sleep(0.1)
        }
    } else {
        output$image_frame <- renderImage(
            list(src=frame_path_to_print())
        )
    }
}
shinyApp(ui, server)

我已成功添加“上一个”和“下一个”按钮，但我无法让“自动播放”按钮工作。除了上面的代码之外，我还尝试了几件事，比如让它在循环或 *apply 函数上调用与“下一步”按钮相同的操作，我尝试将它们放在服务器函数的几个位置，但没有任何效果。我仍然对响应式环境的工作方式感到有些困惑，所以如果知道这根本不是这样做的方式，我不会感到惊讶，但我在 Internet 上找不到任何关于它的信息。

Answer 1

因此，尽管我已经为此工作了几天，但幸运的是，我刚刚找到了来自 a related question 的解决方案。

诀窍在于sliderInput 函数包含一个animate 参数，当设置为TRUE 时，会添加一个自动通过帧的播放按钮。更多信息here。

我仍然对其他涉及工作自动播放按钮而不是不同 UI 对象上的小按钮的解决方案感到好奇。

Answer 2

这是一个使用 JavaScript 库 slick 的解决方案。 slick 文件可here 下载，您必须将它们放在 www 子文件夹中。

library(shiny)

# images to be displayed ####
## these images are in the www subfolder
images <- c("img1.JPG", "img2.JPG", "img3.JPG", "img4.JPG", "img5.JPG")

# ui #####
ui <- fluidPage(
  tags$head(
    tags$link(rel="stylesheet", type="text/css",
              href="slick-1.8.1/slick/slick-theme.css"),
    tags$link(rel="stylesheet", type="text/css",
              href="slick-1.8.1/slick/slick.css"),
    tags$script(type="text/javascript", 
                src="slick-1.8.1/slick/slick.js"),
    tags$script(HTML("
function runSlick(){
  $('#images').slick({
    arrows: true,
    dots: true,
    slidesToShow: 1,
    slidesToScroll: 1,
    autoplay: false
  });
}
function autoplay(x){
  if(x % 2 === 1){
    $('#images').slick('slickPlay');
  }else{
    $('#images').slick('slickPause');
  }
}
Shiny.addCustomMessageHandler('autoplay', autoplay);")),
    tags$style(HTML("
#images .slick-prev {
    position:absolute;
  top:65px; 
  left:-50px;
}
#images .slick-next {
  position:absolute;
  top:95px; 
  left:-50px;
}
.slick-prev:before, .slick-next:before { 
  color:red !important;
  font-size: 30px;
}
#content {
  margin: auto;
  padding: 2px;
  width: 90%;
}"))
  ),

  sidebarLayout(

    sidebarPanel(
      actionButton("go", "play/pause")
    ),

    mainPanel(
      uiOutput("content")
    )
  )
)

# server #####
server <- function(input, output, session){

  output[["content"]] <- renderUI({
    imgs <- sapply(images, function(img){
      tags$div(tags$img(src = img, width = "400px", height = "400px"))
    }, simplify = FALSE, USE.NAMES = FALSE)
    container <- do.call(function(...) tags$div(id="images", ...), imgs)
    tagList(container, tags$script(HTML("runSlick();")))
  })

  observeEvent(input[["go"]], {
    session$sendCustomMessage("autoplay", input[["go"]])
  })

}

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