如何在切换轮播图时保留Controlbar的状态

在使用slickR或swipeR结合bs4Dash的Controlbar组件时，点击轮播箭头切换图片会导致Controlbar的状态被重置（比如原本展开的Controlbar自动收起）。以下是针对两个轮播组件的解决方案，可维持collapsed = FALSE、overlay = FALSE这类设置的状态。

一、slickR 实现方案 #

修改后完整代码 #

library(svglite)
library(shiny)
library(ggplot2)
library(slickR)
library(bs4Dash)

ui <- bs4DashPage(
  bs4DashNavbar(
    title = "SlickR with Controlbar"
  ),
  sidebar = bs4DashSidebar(disable = TRUE),
  # 动态生成Controlbar，替代静态定义
  controlbar = uiOutput("dynamic_controlbar"),
  body = bs4DashBody(
    fluidRow(
      column(
        12,
        slickROutput("slick_output", width = "90%", height = "200px")
      )
    )
  )
)

server <- function(input, output) {
  # 初始化Controlbar状态，对应初始展开状态（collapsed = FALSE）
  controlbar_collapsed <- reactiveVal(FALSE)
  
  # 监听Controlbar折叠/展开事件，实时更新状态值
  observeEvent(input$controlbarCollapsed, {
    controlbar_collapsed(input$controlbarCollapsed)
  })
  
  # 动态渲染Controlbar，绑定当前状态
  output$dynamic_controlbar <- renderUI({
    bs4DashControlbar(
      width = 300,
      collapsed = controlbar_collapsed(),
      overlay = FALSE,
      p("Controlbar Content")
    )
  })
  
  ggplot_list <- list(
    ggplot(mtcars, aes(mpg, wt)) +
      geom_point() +
      ggtitle("Plot 1"),
    ggplot(mtcars, aes(hp, wt)) +
      geom_point() +
      ggtitle("Plot 2")
  )

  ggplot_list_svg <- lapply(ggplot_list, function(x) {
    xmlSVG(print(x), standalone = TRUE)
  })

  output$slick_output <- renderSlickR({
    suppressWarnings(slickR(ggplot_list_svg,
      slideId = "slick1",
      height = 600,
      width = "50%"
    )) +
      settings(slidesToShow = 1, centerMode = TRUE)
  })
}

shinyApp(ui = ui, server = server)

关键改动说明 #

• 用reactiveVal存储Controlbar的当前折叠状态，确保状态可被跟踪和复用
• 通过renderUI动态生成Controlbar，将collapsed参数绑定到状态值，避免轮播切换时状态被重置
• 监听bs4Dash内置的input$controlbarCollapsed事件，实时同步用户手动调整的Controlbar状态

二、swipeR 实现方案 #

修改后完整代码 #

library(svglite)
library(shiny)
library(ggplot2)
library(swipeR)
library(bs4Dash)

ui <- bs4DashPage(
  bs4DashNavbar(
    title = "SwipeR with Controlbar"
  ),
  sidebar = bs4DashSidebar(disable = TRUE),
  # 动态生成Controlbar
  controlbar = uiOutput("dynamic_controlbar"),
  body = bs4DashBody(
    fluidRow(
      column(
        12,
        swipeROutput("swipe_output", width = "90%", height = "400px")
      )
    )
  )
)

server <- function(input, output) {
  # 初始化Controlbar状态
  controlbar_collapsed <- reactiveVal(FALSE)
  
  # 监听Controlbar状态变化
  observeEvent(input$controlbarCollapsed, {
    controlbar_collapsed(input$controlbarCollapsed)
  })
  
  # 动态渲染Controlbar，绑定当前状态
  output$dynamic_controlbar <- renderUI({
    bs4DashControlbar(
      width = 300,
      collapsed = controlbar_collapsed(),
      overlay = FALSE,
      p("Controlbar Content")
    )
  })
  
  ggplot_list <- list(
    ggplot(mtcars, aes(mpg, wt)) +
      geom_point() +
      ggtitle("Plot 1"),
    ggplot(mtcars, aes(hp, wt)) +
      geom_point() +
      ggtitle("Plot 2")
  )

  ggplot_svg_list <- lapply(ggplot_list, function(plot) {
    svg_xml <- xmlSVG(print(plot), standalone = TRUE) 
    as.character(svg_xml)
  })

  slides <- lapply(ggplot_svg_list, function(svg) {
    tags$div(
      class = "swiper-slide",
      style = "text-align: center;",
      HTML(svg)
    )
  })

  output$swipe_output <- renderSwipeR({
    swipeR(
      tags$div(
        class = "swiper-wrapper",
        slides
      ),
      height = "400px",
      navigationColor = "navy"
    )
  })
}

shinyApp(ui = ui, server = server)

关键改动说明 #

• 逻辑与slickR方案完全一致，核心是通过动态UI绑定Controlbar状态
• 即使swipeR的轮播交互本身不会触发Shiny的响应式刷新，动态绑定依然能保证Controlbar维持用户设置的展开/收起状态

内容的提问来源于stack exchange，提问作者Ferroao