简体   繁体   中英

Get the current image name of a slickR slideshow in shiny

Below is a shiny app which displays a slideshow of images with the slickR package. How to get the name of the current image?

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)

Here is a solution with a 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)

在此处输入图片说明

Another solution, simpler: replace js with

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

Maybe something like this workaround?

I am using the index of the image and get the basename of the imagelist.

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)

The slickR shiny vignette describes the "official" way without using custom 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 : The index of the clicked element
  • .relative_clicked : The relative position of the clicked element
  • .center : The index of the center element
  • .total : The total number of elements in the carousel
  • .active : The ID of the active carousel

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)

Here's a solution from one of the slickR vi.nettes :

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) )

Worked great for me.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM