Get the current image name of a slickR slideshow in shiny - r

Question

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)

Answer 1

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);
});
})"

Answer 2

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)

Answer 3

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)

Answer 4

Here's a solution from 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) )
Worked great for me.