如何将自动播放按钮添加到Shiny应用中？

Question

我正在编写一个Shiny应用，它可以加载一连串的图像（即帧），并包含一个 "自动播放 "按钮来自动浏览所有的图像。

这里是代码相关部分的MRE版本。自动播放按钮是作为UI对象间接生成的，因为还涉及到一个动态选框滑块。可以获得PNG文件的样本 此处.

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函数，我还试过把这些放在服务器函数的几个地方，但都没有用。我对反应式环境的工作原理还是有点迷茫，所以我不会感到奇怪，知道这根本不是办法，但我在网上找不到任何关于这方面的资料。

Answer 1

所以，尽管我已经为此工作了好几天，但由于运气好，我刚刚找到了一个解决方案，来自于 相关问题.

诀窍是 sliderInput 函数包含一个 animate 参数，当设置为 TRUE在此基础上，增加了一个自动通过帧的播放按钮。更多信息 此处.

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

Answer 2

下面是一个使用JavaScript库的解决方案 滑溜溜. 该 滑溜溜 文件可下载 此处，你必须把他们在 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)