r - 以闪亮的方式获取 slickR 幻灯片的当前图像名称

Question

下面是一个闪亮的应用程序，它显示带有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)

Answer 1

这是一个解决方案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);
  });
})"

Answer 2

也许像这样的解决方法？

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

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)

Answer 3

slickR闪亮的小插图描述了不使用自定义 JS 的“官方”方式：

观察活动
的 slick htmlwidget 被shiny 观察并且可以检索信息。

renderSlick使用您在此示例中为对象设置的输出名称使用此名称，output$slick_output
您可以通过访问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)