Basic Bootrap Tour R wrapper example

bst.R

# Bootstrap tour step
.bsTourStep <- function(i, id, title, content, pos = "right", tab = NULL){
  id <- paste0("#", id)
  x <- paste0("    {\n      element: \"", id,
              "\",\n      title: \"", title,
              "\",\n      content: \"", content,
              "\",\n      placement: \"", pos, "\"")
  if(i==1 && !is.null(tab)){
    x <- paste0(x, ",\n      onShow: function (tour) { $(\"", tab, "\").tab('show');}\n    }")
  } else {
    x <- paste0(x, "\n    }")
  }
  x
}

# Bootstrap tour
bsTour <- function(id, title, content, pos = "right", tab = NULL){
  n <- length(id)
  if(length(title) != n | length(content) != n)
    stop("'id', 'title', and 'content' lengths uneuqal.")
  np <- length(pos)
  if(n > 1 & np == 1) pos <- rep(pos, n)
  if(n > 1 & np < n) pos <- c(pos, rep("right", n - np))
  
  x <- purrr::map_chr(1:n,
    ~.bsTourStep(.x, id[.x], title[.x], content[.x], pos[.x], tab))
  if(n > 1) x <- paste(x, collapse = ",\n")
  htmlwidgets::JS(
    paste0("var tour = new Tour({\n  steps: [\n",
           x, "\n  ]\n});\ntour.init();\ntour.start();\n")
  )
}

# Example tour JS output
ids <- paste0("plot", 1:4)
titles <- paste("My plot", 1:4)
contents <- paste("Description for plot", 1:4)
pos <- c("bottom", "left", "top", "right")

cat(bsTour(id=ids[1], title=titles[1], content=contents[1]))
cat(bsTour(id=ids[1], title=titles[1], content=contents[1], pos="bottom"))
cat(bsTour(id=ids[1], title=titles[1], content=contents[1], pos="left", tab="tab1"))
cat(bsTour(id=ids, title=titles, content=contents, pos=pos, tab="tab1"))