Shiny / Carousel

shiny-carousel.R

library(shiny)

ol <- function(...) tag("ol", list(...))
li <- function(...) tag("li", list(...))

carousel_events <- function(id) 
{
  js <- sprintf("
    $('#%s').bind('slide.bs.carousel', function (e) { 
      $(e.relatedTarget).find('.shiny-bound-output').each(function(i) {
        $('#' + this.id).trigger('shown')
      });
      $(e.target).find('.shiny-bound-output').each(function(i) {
        $('#' + this.id).trigger('hidden')
      }); 
    });
  ", id)
  
  tag("script", gsub("\n", "", js))
}

#' Bootstrap Carousel
#'
#' Create a bootstrap carousel for UI elements.
#'
#' @param id character: The identifier for the carousel.
#' @param ... Shiny UI components.
#' @param height character: the height (in CSS format)
#' @param width character: the width (in CSS format)
#' @param interval numeric: milliseconds delay interval.
#'
#' @return A Shiny UI component
#' @export
carousel <- function(id, ..., height = "1024px", width = "100%", interval = 5000)
{
  # Capture the carousel content items
  dots <- list(...)
  
  # Prepare the items
  classes <- c("item active", rep("item", length(dots)))
  items <- lapply(seq_along(dots), function(i) div(class = classes[i], dots[[i]]))
  
  # Setup the inner carousel
  caro_inner <- div(class = "carousel-inner", role = "listbox")
  caro_inner$children <- items
  
  # Setup the indicator bullets
  indicators <- ol(class = "carousel-indicators")
  indicators$children <- lapply(seq_along(dots), function(i) {
    if (i == 1)
      li(`data-target` = paste0("#", id), `data-slide-to` = "0", class = "active")
    else
      li(`data-target` = paste0("#", id), `data-slide-to` = as.character(i - 1))
  })
  
  # Construct the actual carousel object
  caro <- div(id = id, class = "carousel slide", `data-ride` = "carousel",
             `data-interval` = as.character(interval),
              style = sprintf("height:%s; width:%s;",
                              height,
                              width))
  
  caro$children <- list(caro_inner, indicators)
  
  return(tagList(caro, carousel_events(id)))
}

slide1 <- div(h1("iris plot"),   plotOutput("plot1"))
slide2 <- div(h1("mtcars plot"), plotOutput("plot2"), tableOutput("iris"))
slide3 <- div(h1("iris2 plot"),  plotOutput("plot3"), plotOutput("plot3b"))

runApp(list(
  ui = shinyUI(bootstrapPage(
    titlePanel("Carousel Example"),
    carousel("caro", slide1, slide2, slide3)
  )),
  server = shinyServer(function(input, output, session) {
    output$plot1 <- renderPlot(plot(Sepal.Width ~ Sepal.Length, data = iris))
    output$plot2 <- renderPlot(plot(hp ~ cyl, data = mtcars))
    output$plot3 <- renderPlot(plot(Petal.Width ~ Petal.Length, data = iris))
    output$plot3b <- renderPlot(plot(Sepal.Width ~ Sepal.Length, data = iris))
    output$iris <- renderTable(iris)
  })
))

could make it work using

$('#caro').bind('slide.bs.carousel', function (e) { 
  $(e.relatedTarget).find('.shiny-bound-output').each(function(i) {
    $('#' + this.id).trigger('shown')
  });
  $(e.target).find('.shiny-bound-output').each(function(i) {
    $('#' + this.id).trigger('hidden')
  }); 
});

Not sure whether that is a best way to do it.