r - 动态图像轮播 R 闪亮

Question

我想根据过滤列表在闪亮的仪表板中动态添加图像轮播。我已经尝试过 shinydashboardPlus 包以及 slickR 包，但似乎无法让它们中的任何一个工作。

尽我所能使用 shinydashboardPlus 重现一个简短的示例。不反对使用其他包。

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)

您可以使用这些图像进行测试。

Answer 1

似乎问题在于您如何构建items. 您的images()反应变量已经具有图像标签。tags$img所以在构建列表时不需要再次使用。您也使用该Map()函数，但您似乎实际上并没有映射任何值。尝试

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

这会将您的所有图像标签包装在适当的carouselItem()包装器中。

此外，您不能提供与您carousel()相同的 ID uiOutput()。确保它们具有不同的 ID，否则 javascript 会混淆。

Answer 2

一个简短的可重复的 slickR 示例，对细节进行了一些更改。

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)