Dynamic Image Carousel R Shiny

Question

I would like to dynamically add a carousel of images within a shiny dashboard based on a filtered list. I have tried the shinydashboardPlus package as well as the slickR package but can't seem to get either of them to work.

Tried my best to reproduce a short example using shinydashboardPlus. Not opposed to using other packages.

library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(DT)
library(shinyWidgets)

df <- data.frame(
  name = c("rose", "carnation", "hydrangea"),
  color = c("red", "pink", "blue"),
  Picture = c("rose.jpg", "carnation.jpg", "hydrangea.jpg")
)

ui <- dashboardPage(
  dashboardHeader(title = "Dynamic Carousel", 
                  titleWidth =300
                  
  ),
  
  dashboardSidebar(width = 300,
                   
                   pickerInput(inputId = "color", 
                               label = "Options",
                               pickerOptions(width = "fit"),
                               choices = df$color, 
                               selected = df$color,
                               multiple = TRUE,
                               options = pickerOptions(actionsBox = TRUE, dropupAuto = FALSE))
                   
                   ),
  dashboardBody(
    fluidRow(width = 6,
             
             uiOutput("carousel")
             
             ),
    
    fluidRow(width = 12,
             dataTableOutput("table")
             )
  )
)

server <- function(input, output) {
  
  filtered <- reactive({
    df %>%
      filter(color %in% input$color)
  })
  
  images <- reactive({
    
    images <- lapply(filtered()$Picture,function(x){
      htmltools::tags$img(src = x)
    })
    
    return(images)
    
  })
  
  output$carousel <- renderUI({
    
    items = Map(function(i) {carouselItem(
      tags$img(src = images()[[i]])
    )})
    
    carousel(indicators = TRUE,
             id = "carousel",
             .list = items
    )
    
  })
  
  output$table <- renderDT(filtered())
  
}

shinyApp(ui = ui, server = server)

You can use these images for testing.

Answer 1

It seems the problem is how you are building the list of items. Your images() reactive variable already has the image tags. So you don't need to use tags$img again when you build the list. Also you using the Map() function but you don't seem to actually be mapping over any values. Try

    items <- Map(function(img) {carouselItem(img)}, images())

This will wrap all your image tags in the proper carouselItem() wrapper.

Also you can't give your carousel() the same ID as your uiOutput(). Make sure they have distinct IDs otherwise the javascript will get confused.

Answer 2

A short reproducible slickR example with a few changes to the details.

library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(DT)
library(shinyWidgets)

df <- data.frame(
  name = c("rose", "carnation", "hydrangea"),
  color = c("red", "pink", "blue"),
  Picture = c("rose.jpg", "carnation.jpg", "hydrangea.jpg")
)

ui <- dashboardPage(
  dashboardHeader(title = "Dynamic Carousel", 
                  titleWidth =300
                  
  ),
  
  dashboardSidebar(width = 300,
                   
                   pickerInput(inputId = "color", 
                               label = "Options",
                               pickerOptions(width = "fit"),
                               choices = df$color, 
                               selected = df$color,
                               multiple = TRUE,
                               options = pickerOptions(actionsBox = TRUE, dropupAuto = FALSE))
                   
                   ),
  dashboardBody(
    fluidRow(
             
             box(width = 12,
               slickROutput("slick_output", width = "70%", height = "250px")
             )
             
             
             
             ),
    
    fluidRow(
             box(width = 12,
               dataTableOutput("table")
             )
             )
  )
)

server <- function(input, output) {
  
  filtered <- reactive({
    df %>%
      filter(color %in% input$color)
  })
  
  images <- reactive({
    
    images <- lapply(filtered()$Picture,function(x){
      htmltools::tags$img(src = x, width = "400px", height = "225px", style="margin-left: auto;  margin-right: auto;")
    })
    
    return(images)
    
  })
  
  output$slick_output <- renderSlickR({
    
    slickR(images(),
           slideId = 'myslick') + 
      settings(dots = TRUE,
               slidesToShow = 2,
               slidesToScroll = 2,
               autoplay = TRUE)
    
  })
  
  output$table <- renderDT(filtered())
  
}

shinyApp(ui = ui, server = server)