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)