Shinydasboard introjs.R

library(shinydashboard)
library(rintrojs)

add_class <- function(x, class) {
  x$attribs <- append(x$attribs, list(class = class))
  x
}

# # Alternatively, override the functions of shiny/shinydashboard
# menuItem <- function(text, tabName, ...) {
#   r <- shinydashboard::menuItem(text, ...)
#   add_class(r, tabName)
# } 
# box <- function(..., class) {
#   r <- shinydashboard::box(...)
#   add_class(r, class)
# }
# plotOutput <- function(outputId, ...) {
#   r <- shiny::plotOutput(outputId = outputId, ...)
#   add_class(r, outputId)
# }
# actionButton <- function(inputId, ...) {
#   r <- shiny::actionButton(inputId, ...)
#   add_class(r, inputId)
# }



steps_general <- tibble::tribble(
  ~element, ~intro,
  NA, "First Empty State",
  ".view_1", "First Item",
  ".view_2", "Second Item",
  ".btn_info", "This Help Button",
)

steps_view1 <- tibble::tribble(
  ~element, ~intro,
  NA, "This is the header of view 1",
  ".first_box", "A First Box",
  ".plot1", "A First Plot",
  ".btn_view1", "This Help button",
  
)
steps_view2 <- tibble::tribble(
  ~element, ~intro,
  NA, "This is the header of view 2",
  ".second_box", "A Second Box",
  ".plot2", "A Second Plot",
  ".btn_view2", "This help button",
)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Menu 1", tabName = "view_1", icon = icon("sliders")) %>% add_class("view_1"),
      menuItem("Menu 2", tabName = "view_2", icon = icon("chart-line")) %>% add_class("view_2"),
      actionButton("btn_info", "Help", style = "background-color: #FF4444;") %>% add_class("btn_info")
    )
  ),
  dashboardBody(
    introjsUI(),
    tabItems(
      tabItem(tabName = "view_1",
              box(title = "A first Box",
                  sliderInput("num_points", "Number of Points", 100, 1000, step = 100, value = 100),
                  plotOutput("plot1") %>% add_class("plot1"),
                  actionButton("btn_view1", "Help this tab", style = "background-color: #FF4444;") %>% add_class("btn_view1")
              ) %>% add_class("first_box")
      ),
      tabItem(tabName = "view_2",
              box(title = "A Second Box", class = "second_box",
                  actionButton("btn", "Swap Color"),
                  plotOutput("plot2") %>% add_class("plot2"),
                  actionButton("btn_view2", "Help this tab", style = "background-color: #FF4444;") %>% add_class("btn_view2")
              ) %>% add_class("second_box")
      )
    )
  )
)

server <- function(input, output, session) {
  output$plot1 <- renderPlot({
    hist(rnorm(input$num_points))
  })
  
  output$plot2 <- renderPlot({
    cols <- c("red", "green", "blue", "yellow")
    col <- cols[input$btn %% length(cols) + 1]
    set.seed(123)
    plot(rnorm(10), rnorm(10), col = col)
  })
  
  observeEvent(input$btn_info, introjs(session, options = list(steps = steps_general)))
  observeEvent(input$btn_view1, introjs(session, options = list(steps = steps_view1)))
  observeEvent(input$btn_view2, introjs(session, options = list(steps = steps_view2)))
  
}

shinyApp(ui, server)