获取闪亮的 slickR 幻灯片的当前图像名称

Get the current image name of a slickR slideshow in shiny

下面是一个闪亮的应用程序,它使用 slickR 包显示图像幻灯片。如何获取当前图片的名称?

library(shiny)
library(slickR)

ui <- fluidPage(
  tags$div(
      slickROutput("slickr", width="500px"),
      style = "margin-left:100px;"
  )
)

server <- function(input, output) {

  imgs <- list.files("~/", pattern=".png", full.names = TRUE)

  output[["slickr"]] <- renderSlickR({
    slickR(imgs)
  })

}

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

这是一个 MutationObserver 的解决方案:

library(shiny)
library(slickR)

js <- "
$(document).ready(function(){
  var ss = document.getElementById('slickr');
  // create an observer instance
  var observer = new MutationObserver(function(mutations) {
    var index = $(ss).find('.slick-current').data('slick-index');
    Shiny.setInputValue('imageIndex', parseInt(index)+1);
  });
  // configuration of the observer
  var config = {subtree: true, attributes: true};
  // observe 
  observer.observe(ss, config);
})
"

ui <- fluidPage(
  tags$head(
    tags$script(HTML(js))
  ),
  textOutput("imgName"),
  tags$hr(),
  tags$div(
      slickROutput("slickr", width="500px"),
      style = "margin-left:100px;"
  )
)

server <- function(input, output) {

  imgs <- list.files("~/", pattern=".png", full.names = TRUE)

  output[["slickr"]] <- renderSlickR({
    slickR(imgs)
  })

  output[["imgName"]] <- renderText({
    paste0("CURRENT IMAGE: ", basename(imgs[input[["imageIndex"]]]))
  })

}

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

另一个更简单的解决方案:将 js 替换为

js <- "
$(document).ready(function(){
  $('#slickr').on('setPosition', function(event, slick) {
    var index = slick.currentSlide + 1;
    Shiny.setInputValue('imageIndex', index);
  });
})"

也许是这样的解决方法?

我正在使用图像的索引并获取图像列表的基本名称。

library(shiny)
library(slickR)

jscode <- HTML("
$(document).on('shiny:connected', function(event) {
  var imagindex = 0;
  Shiny.onInputChange('slickin', imagindex);
  $(document).on('click', '.slick-arrow', function(event) {
    var imagindex = $('.slick-active')[0].attributes[1].value;
    Shiny.onInputChange('slickin', imagindex);
  });
  $(document).on('click', '.slick-dots', function(event) {
    var imagindex = $('.slick-active')[0].attributes[1].value;
    Shiny.onInputChange('slickin', imagindex);
  });
});
")

ui <- fluidPage(
  tags$head(tags$script(jscode)),
  tags$div(
    slickROutput("slickr", width="500px"),
    style = "margin-left:100px;"
  )
)

server <- function(input, output) {

  imgs <- list.files(getwd(), pattern=".png", full.names = TRUE);

  output[["slickr"]] <- renderSlickR({
    slickR(imgs)
  })

  observe( {
    req(input$slickin)
    print(basename(imgs[as.numeric(input$slickin) + 1]))
  })
}

shinyApp(ui = ui, server = server)

slickR shiny vignette 描述了不使用自定义 JS 的“官方”方式:

Observe the active slick
The htmlwidget is observed by shiny and information can be retrieved.

Using the output name you set for the renderSlick object in this example it is output$slick_output
Using this you can interact server-side "on click" of the active carousel by accessing elements in input$slick_output_current$

  • .clicked : 被点击元素的索引
  • .relative_clicked:被点击元素的相对位置
  • .center : 中心元素的索引
  • .total : 轮播中的元素总数
  • .active : 活动轮播的ID

library(shiny)
library(slickR)

# create some local images
if(!dir.exists("myimages")){
  dir.create("myimages")
}

imgs <- paste0("myimages/myplot", seq_len(3), ".png")

for (myPlot in myPlots) {
  png(file = myPlot, bg = "transparent")
  plot(runif(10))
  dev.off() 
}

ui <- fluidPage(
  tags$head(
    tags$script(HTML(js))
  ),
  textOutput("imgName"),
  tags$hr(),
  tags$div(
    slickROutput("slickr", width="500px"),
    style = "margin-left:100px;"
  )
)

server <- function(input, output) {

  output[["slickr"]] <- renderSlickR({
    slickR(imgs)
  })
  
  output[["imgName"]] <- renderText({
    paste0("CURRENT IMAGE: ", basename(imgs[input$slickr_current$.center]))
  })
  
}

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

这是来自 one of the slickR vignettes 的解决方案:

slickR(obj = nba_player_logo$uri[1:2], height = 100, width = "95%") %synch%
( slickR(nba_player_logo$name[1:2], slideType = 'p') + settings(arrows = FALSE) )

对我来说效果很好。