SlickR Shiny R dynamically convert dots to images when filtering the carousel obj by user input

Question

Have been working through this slickR problem for a while. I would greatly appreciate any input or fresh perspectives on how to resolve this issue or different ways to approach a solution.

There are two issues I've been working through:

The first I think can be solved using CSS, which I am not super familiar with, slickR seems to be creating multiple divs when the 'obj' is updated through the use of input$series. This is undesirable since it relocates the most recent div lower on the page. I tried using javascript, which I am also not very familiar with, to destroy the old slick using an observe event. Bonus points for a simple solution for that issue.

The main issue I am working to resolve is that I would like to convert the dots to images and have them update dynamically as each series is selected. The goal here is that I would like to have a larger image displayed above and a series of 'thumbnails' displayed below so that the user can have some idea of what each photo looks like without having to scroll through every image in the carousel.

My app is much more complicated than this example, but I am using slickR since it has a convenient way to access the current, active, and center slides, which I am using to filter an additional dataframe to render the display of information regarding each active/centered image in the carousel.

Here is an example which demonstrates both issues:

library(shiny)
library(shinyjs)
library(shinydashboard)
library(shinydashboardPlus)
library(jsonlite)
library(htmltools)
library(htmlwidgets)
library(slickR)

fish <- c(
  "https://www.hakaimagazine.com/wp-content/uploads/aquarium-reef-fish-banner.jpg",
  "https://www.hakaimagazine.com/wp-content/uploads/aquarium-reef-fish-banggai-cardinalfish.jpg",
  "https://www.sonomamag.com/wp-content/uploads/2016/12/fish.jpg" )

butterfly <- c(
  "https://www.futurity.org/wp/wp-content/uploads/2019/02/viceroy-butterfly_1600.jpg",
  "https://harvardforest.fas.harvard.edu/sites/harvardforest.fas.harvard.edu/files/butterfly_giant_swallowtail_model.jpg",
  "https://www.butterflyidentification.com/wp-content/uploads/2019/02/Doris-Longwing-Butterfly-Images.jpg"
)

bird <- c(
  "http://www.cutepetname.com/wp-content/uploads/2018/11/funy-bird-names-feat-img.jpeg",
  "http://3.bp.blogspot.com/-mJ-Kw1mdLOo/UeLJx7vxsaI/AAAAAAAADkg/TfDHtuJnY7I/s1600/The-Cardinal-Bird.jpg",
  "https://images7.alphacoders.com/416/thumb-1920-416332.jpg"
)

df <- data.frame(fish=fish, butterfly=butterfly, bird=bird)
pics <- df[,"fish"]

ui <- dashboardPagePlus(
  useShinyjs(),
  
  header = dashboardHeaderPlus(disable = TRUE ),
  sidebar = dashboardSidebar(
    
    radioButtons('series', "Choose Series", 
                 choices = c("fish"="fish", "butterfly"="butterfly", "bird"="bird")
                 ) 
    ),
  
  body = dashboardBody(
    
    tags$script( sprintf("var dotObj = %s", jsonlite::toJSON( 'dots')) ),
    
    slickROutput('slickRCarousel'),
    
    uiOutput('dots')
    
  )
)



server <- function(input, output, session) {
  
  # unslick to counteract slick generating multiple divs?
   observeEvent(input$series, ignoreInit = TRUE, {
     runjs("$('.slickRCarousel').slick('unslick');")
    print(df[,input$series])
  })
  
 
  # observe({
  #   print(input$slickROutput_current$.clicked)
  # })
  
  output$dots <- renderPrint({
    c(df[,input$series])
  })
  
  
  # carousel setup
    cP2 <- JS("function(slick,index) {
          return '<a><img src= ' + dotObj[index] + '  width=30px height=30px></a>';
          }")
  
  opts <- 
    settings(
      initialSlide = 1,
      slidesToShow = 3,
      slidesToScroll = 1,
      centerMode = TRUE,
      focusOnSelect = TRUE,
      dots = TRUE,
      customPaging = cP2
    )
  
  output$slickRCarousel <- renderSlickR({
    
    slick_dots_logo <- slickR(
      obj = df[,input$series],
      height = 100,
      width = "95%"
    ) + opts
    
  })
  
  
}

shinyApp(ui, server)

Thank you in advance for taking the time to look at this!

EDIT 1: Clarification and Current Approach

Here is my current approach, attempting to pass a dynamic value through session$sendCustomMessage and update the variable responsible for rendering the slickR dots (or thumbnails).

The persistent issues are:

the carousel jumps when the radio buttons are changed
the thumbnails are not updating when the radio buttons are changed

code:

library(shiny)
library(shinyjs)
library(shinydashboard)
library(shinydashboardPlus)
library(jsonlite)
library(htmltools)
library(htmlwidgets)
library(slickR)

fish <- c(
  "https://www.hakaimagazine.com/wp-content/uploads/aquarium-reef-fish-banner.jpg",
  "https://www.hakaimagazine.com/wp-content/uploads/aquarium-reef-fish-banggai-cardinalfish.jpg",
 "https://www.sonomamag.com/wp-content/uploads/2016/12/fish.jpg" )

butterfly <- c(
  "https://www.futurity.org/wp/wp-content/uploads/2019/02/viceroy-butterfly_1600.jpg",
  "https://harvardforest.fas.harvard.edu/sites/harvardforest.fas.harvard.edu/files/butterfly_giant_swallowtail_model.jpg",
  "https://www.butterflyidentification.com/wp-content/uploads/2019/02/Doris-Longwing-Butterfly-Images.jpg"
)

bird <- c(
  "http://www.cutepetname.com/wp-content/uploads/2018/11/funy-bird-names-feat-img.jpeg",
  "http://3.bp.blogspot.com/-mJ-Kw1mdLOo/UeLJx7vxsaI/AAAAAAAADkg/TfDHtuJnY7I/s1600/The-Cardinal-Bird.jpg",
  "https://images7.alphacoders.com/416/thumb-1920-416332.jpg"
)

df <- data.frame(fish=fish, butterfly=butterfly, bird=bird)


ui <- dashboardPagePlus(
  useShinyjs(),
  
  header = dashboardHeaderPlus(disable = TRUE ),
  sidebar = dashboardSidebar(
    
    radioButtons('series', "Choose Series", 
                 choices = c("fish"="fish", "butterfly"="butterfly", "bird"="bird")
    )
  ),
  
  body = dashboardBody(
    
    # this sets thumbnails to always be fish, replacing with
    # df[,input$series] seems to cause an issue.
    tags$script( HTML(sprintf("var dotObj = %s", jsonlite::toJSON( df[,'fish'])) ) ), 
    
    #attempting to add a custom message handler to update the dots, but it doesn't
    # update
    tags$script("
                  Shiny.addCustomMessageHandler(setDots, function(newDots) {
                    var dotObj = newDots; 
                  });
                "),
    
    slickROutput('slickRCarousel')
    
  )
)


server <- function(input, output, session) {
  
  #custom message handler to update the dots, but it doesn't update
  observe({
    session$sendCustomMessage('setDots', jsonlite::toJSON( df[,input$series]))
    #print(jsonlite::toJSON( df[,input$series]))
  })
  
  # unslick to counteract slick generating multiple divs
  # and pushing the carousel down? It's not working
   observeEvent(input$series, ignoreInit = TRUE, {
     runjs("$('.slickRCarousel').slick('unslick');")
  })
  
  # slickR carousel setup
  cP2 <- JS(
    "function(slick,index) {
            return '<a><img src= ' + dotObj[index] + '  width=30px height=30px></a>';
          }" )
  
  opts <- 
    settings(
      initialSlide = 1,
      slidesToShow = 1,
      slidesToScroll = 1,
      centerMode = TRUE,
      focusOnSelect = TRUE,
      dots = TRUE,
      customPaging = cP2
    )
  
  output$slickRCarousel <- renderSlickR({
  slick_dots_thumb <- slickR(
      obj = df[,input$series],
      height = 100,
      width = "95%"
    ) + opts
    
  })
  
}

shinyApp(ui, server)

EDIT 2: Building on @ismirsehregal 's solution to the display and navigation

Last piece of the puzzle is returning the center or active slide value to the server. The slickR documentation states you can access it like this:

input$mySlick_current$.center

It may be the case that the output$mySlick needs to be created by renderSlickR({}), not renderUI({}).

Here is some updated code from @ismirsehregal 's solution:

library(shiny)
library(htmlwidgets)
library(slickR)

fish <- c(
  "https://www.hakaimagazine.com/wp-content/uploads/aquarium-reef-fish-banner.jpg",
  "https://www.hakaimagazine.com/wp-content/uploads/aquarium-reef-fish-banggai-cardinalfish.jpg",
  "https://www.sonomamag.com/wp-content/uploads/2016/12/fish.jpg"
)

butterfly <- c(
  "https://www.futurity.org/wp/wp-content/uploads/2019/02/viceroy-butterfly_1600.jpg",
  "https://harvardforest.fas.harvard.edu/sites/harvardforest.fas.harvard.edu/files/butterfly_giant_swallowtail_model.jpg",
  "https://www.butterflyidentification.com/wp-content/uploads/2019/02/Doris-Longwing-Butterfly-Images.jpg"
)

bird <- c(
  "http://www.cutepetname.com/wp-content/uploads/2018/11/funy-bird-names-feat-img.jpeg",
  "http://3.bp.blogspot.com/-mJ-Kw1mdLOo/UeLJx7vxsaI/AAAAAAAADkg/TfDHtuJnY7I/s1600/The-Cardinal-Bird.jpg",
  "https://images7.alphacoders.com/416/thumb-1920-416332.jpg"
)

df <- data.frame(fish = fish,
                 butterfly = butterfly,
                 bird = bird)

ui <- fluidPage(uiOutput("mySlick"),
                radioButtons(
                  'series',
                  "Choose Series",
                  choices = c(
                    "fish" = "fish",
                    "butterfly" = "butterfly",
                    "bird" = "bird"
                  )
                ),
                uiOutput('imageInfo')
                )

server <- function(input, output, session) {
  output$mySlick <- renderUI({
    cP2 <- JS(
      "function(slick,index) {
          return '<a><img src= ' + dotObj[index] + '  width=100% height=100%></a>';
          }"
    )
    
    opts_dot_logo <-
      settings(
        initialSlide = 1,
        slidesToShow = 1,
        slidesToScroll = 3,
        centerMode = TRUE,
        focusOnSelect = TRUE,
        dots = TRUE,
        customPaging = cP2
      )
    
    s2 <- htmltools::tags$script(sprintf("var dotObj = %s", jsonlite::toJSON(df[[input$series]])))
    
    slick_dots_logo <- slickR(obj = df[[input$series]],
                              height = 100,
                              width = "95%") + opts_dot_logo
    
    htmltools::tagList(s2, slick_dots_logo)
  })
  
  observeEvent(input$series, ignoreInit = TRUE, {
  
  output$imageInfo <- renderPrint({
    paste("The center image is: ", input$mySlick_current$.center)
    })
  
  #print(input$mySlick_current$.center)
  })
  
  
}

shinyApp(ui, server)

Edit 3: Final Solution

Thanks to the link provided in the comment by @ismirsehregal I was able to pass the index of the center slide back to the server.

code:

library(shiny)
library(htmlwidgets)
library(slickR)

fish <- c(
  "https://www.hakaimagazine.com/wp-content/uploads/aquarium-reef-fish-banner.jpg",
  "https://www.hakaimagazine.com/wp-content/uploads/aquarium-reef-fish-banggai-cardinalfish.jpg",
  "https://www.sonomamag.com/wp-content/uploads/2016/12/fish.jpg"
)

butterfly <- c(
  "https://www.futurity.org/wp/wp-content/uploads/2019/02/viceroy-butterfly_1600.jpg",
  "https://harvardforest.fas.harvard.edu/sites/harvardforest.fas.harvard.edu/files/butterfly_giant_swallowtail_model.jpg",
  "https://www.butterflyidentification.com/wp-content/uploads/2019/02/Doris-Longwing-Butterfly-Images.jpg"
)

bird <- c(
  "http://www.cutepetname.com/wp-content/uploads/2018/11/funy-bird-names-feat-img.jpeg",
  "http://3.bp.blogspot.com/-mJ-Kw1mdLOo/UeLJx7vxsaI/AAAAAAAADkg/TfDHtuJnY7I/s1600/The-Cardinal-Bird.jpg",
  "https://images7.alphacoders.com/416/thumb-1920-416332.jpg"
)

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

df <- data.frame(fish = fish,
                 butterfly = butterfly,
                 bird = bird)

ui <- fluidPage(
  tags$head(
    tags$script(HTML(js))
  ),
  
  uiOutput("mySlick"),
                radioButtons(
                  'series',
                  "Choose Series",
                  choices = c(
                    "fish" = "fish",
                    "butterfly" = "butterfly",
                    "bird" = "bird"
                  )
                ),
                uiOutput('imageInfo')
                )

server <- function(input, output, session) {
  output$mySlick <- renderUI({
    cP2 <- JS(
      "function(slick,index) {
          return '<a><img src= ' + dotObj[index] + '  width=100% height=100%></a>';
          }"
    )
    
    opts_dot_logo <-
      settings(
        initialSlide = 1,
        slidesToShow = 1,
        slidesToScroll = 3,
        centerMode = TRUE,
        focusOnSelect = TRUE,
        dots = TRUE,
        customPaging = cP2
      )
    
    s2 <- htmltools::tags$script(sprintf("var dotObj = %s", jsonlite::toJSON(df[[input$series]])))
    
    slick_dots_logo <- slickR(obj = df[[input$series]],
                              height = 100,
                              width = "95%") + opts_dot_logo
    
    htmltools::tagList(s2, slick_dots_logo)
  })
  
  observeEvent(input$series, ignoreInit = TRUE, {
  
  output$imageInfo <- renderPrint({
    paste("The center image is: ", df[[input$series]][input[['imageIndex']]])
    })
  print(input[['imageIndex']])
  print( df[[input$series]][input[['imageIndex']]] )
  })
  
  
}

shinyApp(ui, server)

FYI I've found a way to render the same output via `renderSlickR` instead of `renderUI`. However, using `input$slick_output_current$.center` still doesn't work. It seems to be a bug in combination with the latest shiny version as their vignette is also broken. I filed an [issue](https://github.com/yonicd/slickR/issues/51) regarding this. — ismirsehregal, Feb 10 '21 at 10:59

score 0 · Answer 1 · answered Feb 07 '21 at 17:19

To display the image in the middle, you could use carousel() function, and list the items in carouselItem() as shown below.

df <- data.frame(fish=fish, butterfly=butterfly, bird=bird)
pics <- df[,"fish"]

jscode <-"
$(document).ready(function(){
            $('#mycarousel').carousel( { interval:  false } );
});"

ui <- dashboardPagePlus(
  useShinyjs(),
  #tags$head(tags$script(HTML(jscode))),  ### to stop the autoplay; does not seem to work
  header = dashboardHeaderPlus(disable = TRUE ),
  sidebar = dashboardSidebar(
    
    radioButtons('series', "Choose Series", 
                 choices = c("fish"="fish", "butterfly"="butterfly", "bird"="bird")
    ) 
  ),
  
  body = dashboardBody(
    
    tags$script( sprintf("var dotObj = %s", jsonlite::toJSON( 'dots')) ),
    
    slickROutput('slickRCarousel'), br(), br(), br(), br(), br(),
    
    uiOutput("carousell")
    # uiOutput('dots')
    
  )
)

server <- function(input, output, session) {
  
  # unslick to counteract slick generating multiple divs?
  observeEvent(input$series, ignoreInit = TRUE, {
    runjs("$('.slickRCarousel').slick('unslick');")
    print(df[,input$series])
  })
  
  # observe({
  #   print(input$slickROutput_current$.clicked)
  # })
  
  output$dots <- renderPrint({
    c(df[,input$series])
  })
  
  output$carousell <- renderUI({
    carousel(
      id = "mycarousel",
      carouselItem(
        caption = "First image",
        tags$img(src = df[1,input$series])
      ),
      carouselItem(
        caption = "An image file",
        tags$img(src = df[2,input$series])
      ),
      carouselItem(
        caption = "Item 3",
        tags$img(src = df[3,input$series])
      )
    )
    
  })
  
  
  # carousel setup
  cP2 <- JS("function(slick,index) {
          return '<a><img src= ' + dotObj[index] + '  width=30px height=30px></a>';
          }")
  
  opts <- 
    settings(
      initialSlide = 1,
      slidesToShow = 3,
      slidesToScroll = 1,
      centerMode = TRUE,
      focusOnSelect = TRUE,
      dots = TRUE,
      customPaging = cP2
    )
  
  output$slickRCarousel <- renderSlickR({
    
    slick_dots_logo <- slickR(
      obj = df[,input$series],
      height = 100,
      width = "75%"
    ) + opts
    
  })
  
  
}

shinyApp(ui, server)

Thanks for the response. I have explored the built in carousel with shinydashboardplus but haven't been able to determine how to return to the server which carousel item is visible. Also, I would like to have the ability to display an assortment of smaller image 'thumbnails' which act as navigation for the carousel. — max, Feb 08 '21 at 00:38
Perhaps `bs_carousel()` with `bs_append()` from `bsplus` package might be of interest to you. — YBS, Feb 08 '21 at 02:39
Thanks, I will check out the bsplus package and update with an answer if I can rig a solution. — max, Feb 08 '21 at 22:11

ismirsehregal · Accepted Answer · 2021-02-22T08:18:04.360

Here is what I think you are after (I didn't use shinydashboardPlus as it isn't relevant regarding the given problem)

Edit: After some fixes you can now achive the same using renderSlickR. You need to install a version including the latest commit:

remotes::install_github("yonicd/slickR@417fd60e013b70540970c1b798897050c3580d2c")

Now also available in a branch:

remotes::install_github("yonicd/slickR@fix_shinyvignette")

Furthermore I found out, that you can avoid the jumping on re-rendering issue via passing the height argument as character (see ?slickR - valid css unit e.g. "100px" or "25vh").

library(shiny)
library(htmlwidgets)
library(slickR)

DF <- data.frame(fish = c(
  "https://www.hakaimagazine.com/wp-content/uploads/aquarium-reef-fish-banner.jpg",
  "https://www.hakaimagazine.com/wp-content/uploads/aquarium-reef-fish-banggai-cardinalfish.jpg",
  "https://www.sonomamag.com/wp-content/uploads/2016/12/fish.jpg"
),
butterfly = c(
  "https://www.futurity.org/wp/wp-content/uploads/2019/02/viceroy-butterfly_1600.jpg",
  "https://harvardforest.fas.harvard.edu/sites/harvardforest.fas.harvard.edu/files/butterfly_giant_swallowtail_model.jpg",
  "https://www.butterflyidentification.com/wp-content/uploads/2019/02/Doris-Longwing-Butterfly-Images.jpg"
),
bird = c(
  "http://www.cutepetname.com/wp-content/uploads/2018/11/funy-bird-names-feat-img.jpeg",
  "http://3.bp.blogspot.com/-mJ-Kw1mdLOo/UeLJx7vxsaI/AAAAAAAADkg/TfDHtuJnY7I/s1600/The-Cardinal-Bird.jpg",
  "https://images7.alphacoders.com/416/thumb-1920-416332.jpg"
))

ui <- fluidPage(slickROutput("mySlick", width = "50%"),
                radioButtons(
                  'series',
                  "Choose Series",
                  choices = c(
                    "fish" = "fish",
                    "butterfly" = "butterfly",
                    "bird" = "bird"
                  )
                ),
                textOutput("center"))

server <- function(input, output, session) {
  output$mySlick <- renderSlickR({

    cP2 <- JS(
      paste0("function(slick,index) {
      var dotObj = ", jsonlite::toJSON(DF[[input$series]]),";
          return '<a><img src= ' + dotObj[index] + '  width=100% height=100%></a>';
          }"))
    
    opts_dot_logo <-
      settings(
        initialSlide = 1,
        slidesToShow = 1,
        slidesToScroll = 3,
        centerMode = TRUE,
        focusOnSelect = TRUE,
        dots = TRUE,
        customPaging = cP2
      )
    
    slick_dots_logo <- slickR(obj = DF[[input$series]],
                              height = "100px") + opts_dot_logo
    
    
    slick_dots_logo
  })
  
  output$center <- renderText({
    paste("Center:", input$mySlick_current$.center)
  })
  
}

shinyApp(ui, server)

renderUI solution:

library(shiny)
library(htmlwidgets)
library(slickR)

fish <- c(
  "https://www.hakaimagazine.com/wp-content/uploads/aquarium-reef-fish-banner.jpg",
  "https://www.hakaimagazine.com/wp-content/uploads/aquarium-reef-fish-banggai-cardinalfish.jpg",
  "https://www.sonomamag.com/wp-content/uploads/2016/12/fish.jpg"
)

butterfly <- c(
  "https://www.futurity.org/wp/wp-content/uploads/2019/02/viceroy-butterfly_1600.jpg",
  "https://harvardforest.fas.harvard.edu/sites/harvardforest.fas.harvard.edu/files/butterfly_giant_swallowtail_model.jpg",
  "https://www.butterflyidentification.com/wp-content/uploads/2019/02/Doris-Longwing-Butterfly-Images.jpg"
)

bird <- c(
  "http://www.cutepetname.com/wp-content/uploads/2018/11/funy-bird-names-feat-img.jpeg",
  "http://3.bp.blogspot.com/-mJ-Kw1mdLOo/UeLJx7vxsaI/AAAAAAAADkg/TfDHtuJnY7I/s1600/The-Cardinal-Bird.jpg",
  "https://images7.alphacoders.com/416/thumb-1920-416332.jpg"
)

df <- data.frame(fish = fish,
                 butterfly = butterfly,
                 bird = bird)

ui <- fluidPage(uiOutput("mySlick"),
                radioButtons(
                  'series',
                  "Choose Series",
                  choices = c(
                    "fish" = "fish",
                    "butterfly" = "butterfly",
                    "bird" = "bird"
                  )
                ))

server <- function(input, output, session) {
  output$mySlick <- renderUI({
    cP2 <- JS(
      "function(slick,index) {
          return '<a><img src= ' + dotObj[index] + '  width=100% height=100%></a>';
          }"
    )
    
    opts_dot_logo <-
      settings(
        initialSlide = 1,
        slidesToShow = 1,
        slidesToScroll = 3,
        centerMode = TRUE,
        focusOnSelect = TRUE,
        dots = TRUE,
        customPaging = cP2
      )
    
    s2 <- htmltools::tags$script(sprintf("var dotObj = %s", jsonlite::toJSON(df[[input$series]])))
    
    slick_dots_logo <- slickR(obj = df[[input$series]],
                              height = 100,
                              width = "95%") + opts_dot_logo
    
    htmltools::tagList(s2, slick_dots_logo)
  })
  
}

shinyApp(ui, server)

Yes! This is really close. The display and navigation through the thumbnails is exactly what I was trying to do. The last issue is that I need to return the 'active-slick' value (either the index or url) to the server to be able to identify the center image. I will update the post to make that more clear. — max, Feb 09 '21 at 16:38
Please keep your question focused. Ask another one if needed. I guess [this](https://stackoverflow.com/questions/56001897/get-the-current-image-name-of-a-slickr-slideshow-in-shiny) is what you are looking for. — ismirsehregal, Feb 09 '21 at 16:48
I appreciate your help, I am new to posting questions on stackoverflow, although I have benefitted greatly from the knowledge shared on here. I will accept your answer as it solved the main issue I was having with the display. You are correct in that the additional issues warrant additional questions. — max, Feb 09 '21 at 16:54
I was able to solve my follow-up question using the link provided in your first comment. I will update my question with the final solution and will follow the guidance for single question posts in the future. Again, thank you for your help! @ismirsehregal — max, Feb 09 '21 at 18:16

SlickR Shiny R dynamically convert dots to images when filtering the carousel obj by user input

2 Answers2