Search code examples
javascriptrshinycarousel

Stop carousel autoplay using R's bsplus, Shiny and JavaScript


Using @YBS suggestion to put, "bs_carousel(...) inside a renderUI" Here is my attempt. The slides render and autoplay is off at first. However, click the right chevron and autoplay begins.

library("shiny")
library("shinyjs")
library("bsplus")

# Stop autoplay
# https://stackoverflow.com/questions/26133618/how-to-stop-bootstrap-carousel-from-autosliding

jscode <- "
shinyjs.init = function() {
  $('.carousel').carousel({ interval: false });
}"

ui <- fluidPage(
  
  shinyjs::useShinyjs(),
  extendShinyjs(text = jscode, functions = c()),
  
  # Application title
  titlePanel("Carousel Demo"),
  
  uiOutput("carousel")
)

server <- shinyServer(function(input, output) {
  output$carousel <- renderUI({
    bs_carousel(id = "images", use_indicators = TRUE) %>%
      bs_append(
        content = bs_carousel_image(src = "https://placehold.it/900x500/3c8dbc/ffffff&text=Merry")
      ) %>%
      bs_append(
        content = bs_carousel_image(src = "https://placehold.it/900x500/3c8dbc/ffffff&text=Christmas")
      ) %>%
      bs_append(
        content = bs_carousel_image(src = "https://placehold.it/900x500/3c8dbc/ffffff&text=To")
      ) %>%
      bs_append(
        content = bs_carousel_image(src = "https://placehold.it/900x500/3c8dbc/ffffff&text=All")
      ) 
  })
  
})

# Run the application
shinyApp(ui = ui, server = server)

Original Question

I am using the carousel from R's bsplus package. I want to stop the auto play. Various solutions have been mentioned here.

I am trying, without success, to implement one of them below.

library("shiny")
library("bsplus")

# Stop autoplay
# https://stackoverflow.com/questions/26133618/how-to-stop-bootstrap-carousel-from-autosliding

jscode <- "
shinyjs.init = function() {
  $('.carousel').carousel({ interval: false });
}"

ui <- shinyUI(fluidPage(
  
  shinyjs::useShinyjs(),
  extendShinyjs(text = jscode, functions = c()),

  # Application title
  titlePanel("Carousel Demo"),
),

bs_carousel(id = "images", use_indicators = TRUE) %>%
  bs_append(
    content = bs_carousel_image(src = "https://placehold.it/900x500/3c8dbc/ffffff&text=Merry")
  ) %>%
  bs_append(
    content = bs_carousel_image(src = "https://placehold.it/900x500/3c8dbc/ffffff&text=Christmas")
  ) %>%
  bs_append(
    content = bs_carousel_image(src = "https://placehold.it/900x500/3c8dbc/ffffff&text=To")
  ) %>%
  bs_append(
    content = bs_carousel_image(src = "https://placehold.it/900x500/3c8dbc/ffffff&text=All")
  ) 

)

server <- shinyServer(function(input, output) {
  
})

# Run the application
shinyApp(ui = ui, server = server)

Solution

  • Somehow the autoplay does not stop in bs_carousel(), unless mouse pointer is hovering over the active slide. However, the code below demonstrates that autoplay can be switched off in carousel() from shinydashboardPlus package.

    library(shiny)
    library(shinydashboardPlus)
    library(DT)
    
    jscode <-"
    $(document).ready(function(){
                $('#mycarousel').carousel( { interval:  false } );
    });"
    
    shinyApp(
      ui = dashboardPage(
        header = dashboardHeader(),
        sidebar = dashboardSidebar(),
        body = dashboardBody(
          tags$head(
            tags$style(HTML("
          #mycarousel {
            width:900px;
            height:600px;
          }
        .carousel-control{
          color:#FF0000;
        }
        "))
          ),
          tags$head(tags$script(HTML(jscode))),
          carousel(
            id = "mycarousel",
            carouselItem(
              DTOutput("show_iris_dt")
            ),
            carouselItem(
              caption = "An image file",
              tags$img(src = "YBS.png")
            ),
            carouselItem(
              caption = "Item 3",
              tags$img(src = "http://placehold.it/900x500/39CCCC/ffffff&text=Happy+New+Year")
            )
          )
        ),
        title = "Carousel Demo"
      ),
      server = function(input, output) {
        output$show_iris_dt <- renderDT({
          datatable(iris)
        })
      }
    )