Как добавить кнопку автозапуска в приложение Shiny

Question

Я пишу приложение Shiny, которое загружает последовательность изображений (т. Е. Кадров) и содержит кнопку «Автозапуск» для go автоматического просмотра всех изображений.

Вот MRE-версия программы соответствующие части кода. Кнопка Autoplay косвенно создается как объект пользовательского интерфейса, потому что здесь задействован также ползунок выбора кадра Dynami c. Примеры файлов 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)

Мне удалось успешно добавить кнопки «предыдущий» и «следующий», но я не могу получить кнопку «автовоспроизведение» работать. В дополнение к приведенному выше коду я пробовал несколько вещей, например, чтобы он вызывал то же действие, что и кнопка «следующий» над al oop или функцией * apply, и я попытался разместить их в нескольких местах серверная функция, но ничего не работает. Я все еще немного запутался в том, как работают реактивные среды, поэтому не удивлюсь, узнав, что это совсем не способ делать это, но я не могу найти ничего об этом в Inte rnet.

Answer 1

Итак, хотя я работал над этим несколько дней, к счастью, я только что нашел решение, которое пришло из связанного вопроса .

Хитрость в том, что Функция sliderInput содержит аргумент animate, который, если установлен в TRUE, добавляет кнопку воспроизведения, которая автоматически перебирает кадры. Подробнее здесь .

Мне все еще интересно узнать о других решениях, которые включают работающую кнопку автозапуска вместо крошечной кнопки на другом объекте пользовательского интерфейса.

Answer 2

Вот решение, использующее JavaScript библиотеку slick . Файлы slick доступны для загрузки здесь , и вы должны поместить их в подпапку www*1008*.

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)