How to keep controlbar status when changing figures in carousel

How to keep status of control bar (open, closed), when clicking the arrows of the carousel. For example, respecting 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 = bs4DashControlbar(
    width = 300,
    collapsed = F,
    overlay = F,
    p("Controlbar Content")
  ),
  body = bs4DashBody(
    fluidRow(
      column(
        12,
        slickROutput("slick_output", width = "90%", height = "200px")
      )
    )
  )
)

server <- function(input, output) {
  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)

or

swipeR

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

ui <- bs4DashPage(
  bs4DashNavbar(
    title = "SwipeR with Controlbar"
  ),
  sidebar = bs4DashSidebar(disable = TRUE),
  controlbar = bs4DashControlbar(
    width = 300,
    collapsed = FALSE,
    overlay = FALSE,
    p("Controlbar Content")
  ),
  body = bs4DashBody(
    fluidRow(
      column(
        12,
        swipeROutput("swipe_output", width = "90%", height = "400px")
      )
    )
  )
)

server <- function(input, output) {
  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)

my answer will focus on slickR. The easiest solution by far is to keep the sidebar pinned using the argument pinned = True in bs4DashControlbar. To quote the docu:

pinned -- Whether to block the controlbar state (TRUE or FALSE). Default to NULL.

And it will stay in place when pinned:

This can also be done using custom JavaScript. We add these scripts to trigger a function each time the document is clicked anywhere which is not close to the sidebar button. This function checks whether a subclass on body exists, that marks the existence of the side panel. If this is the case, we can then use send custom message handler to add or remove the class depending on its previous state. This will keep the sidebar panel out or hidden, depending on the current state.

Full Code:

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

ui <- bs4DashPage(
  bs4DashNavbar(
    title = "SlickR with Controlbar"
  ),
  sidebar = bs4DashSidebar(disable = TRUE),
  controlbar = bs4DashControlbar(
    width = 300,
    collapsed = F,
    overlay = F,
    #pinned = T, # why not used pin to make all this easier?
    p("Controlbar Content")
  ),
  body = bs4DashBody(
    tags$head(
      tags$script(
        HTML("
              $(document).on('click', function(event) {
            // Exclude clicks on the control bar toggle button
            if (!$(event.target).closest('#controlbar-toggle').length) {
              var isOpen = $('body').hasClass('control-sidebar-slide-open');
              Shiny.setInputValue('controlbar_open', isOpen, {priority: 'event'});
            }
          });
              
              Shiny.addCustomMessageHandler('toggleControlbar', function(message) {
                if (message.isOpen) {
                  $('body').addClass('control-sidebar-slide-open');
                } else {
                  $('body').removeClass('control-sidebar-slide-open');
                }
              });
            ")
      )
    ),
    fluidRow(
      column(
        12,
        slickROutput("slick_output", width = "90%", height = "200px")
      )
    )
  )
)

server <- function(input, output, session) {
  ggplot_list <- list(
    ggplot(mtcars, aes(mpg, wt)) +
      geom_point() +
      ggtitle("Plot 1"),
    ggplot(mtcars, aes(hp, wt)) +
      geom_point() +
      ggtitle("Plot 2")
  )
  observeEvent(input$controlbar_open, {
    # Log the current state of the control bar for debugging
    print(paste("Control bar open:", input$controlbar_open))
    # Send a message to the client to update the control bar state
    session$sendCustomMessage(
      type = "toggleControlbar",
      message = list(isOpen = input$controlbar_open)
    )
  })
  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)