Search code examples
rshinycicerone

How to use Cicerone guides in a shiny app with multiple tabs and multiple modules?

I've looked at the documentation for how to use Cicerone with modules, and how to use it with tabs. However in my case of combining the two for a more complex app with nested tabs and nested modules, I've been unable to create a guide that tours through multiple tabs.

When I switch to the second tab that is part of the tour first, and then run the tour, it works, so my element is correct, but somehow it isn't switching to the tab on it's on to put the element in context. (Note that that functionality isn't included here)

Is it possible that when I am on the first tab, the element in the second tab hasn't been created yet? If so, I don't know how the tab and tab_id arguments would ever work, unless it's due to the hierarchical nature of my modules and tabs.

Here is a simplified example app:

library(shiny)
library(tidyverse)
library(cicerone)



# Module for subtabs ------------------------------------------------------

mod_subtabs_ui <- function(id){
  ns <- NS(id)
  tagList(
    tabsetPanel(
      id = ns("subTabs"),
      tabPanel("Chart", mod_chart_ui(ns("chart_1"))),
      tabPanel("Table", mod_table_ui(ns("table_1")))
    )
  )
}

mod_subtabs_server <- function(id){
  moduleServer( id, function(input, output, session){
    ns <- session$ns

    mod_chart_server("chart_1")
    mod_table_server("table_1")
  })
}


# Module for chart --------------------------------------------------------

mod_chart_ui <- function(id) {
  ns <- NS(id)

  tagList(
      plotOutput(ns("chart"))
  )
}

mod_chart_server <- function(id) {
  moduleServer( id, function(input, output, session){
    ns <- session$ns

    output$chart <- renderPlot(ggplot(mtcars, aes(x = mpg, y = cyl)) + geom_point())

  })
}


# Module for table --------------------------------------------------------

mod_table_ui <- function(id) {
  ns <- NS(id)

  tagList(
    sidebarLayout(
      sidebarPanel(
        mod_filter_ui(ns("filter_chart"))),
      mainPanel(
        tableOutput(ns("table"))
      )
    )
  )
}

mod_table_server <- function(id) {
  moduleServer( id, function(input, output, session){
    ns <- session$ns

    filt_mtcars <- isolate(mod_filter_server("filter_chart"))

    output$table <- renderTable(filt_mtcars())

  })
}


# Module for filter -------------------------------------------------------

mod_filter_ui <- function(id) {
  ns <- NS(id)
  tagList(
      selectInput(ns("cyl_filt"),
                  label = "Filter for # of Cylinders",
                  choices = NULL)
    )
}

mod_filter_server <- function(id) {
  moduleServer( id, function(input, output, session){
    ns <- session$ns

    updateSelectInput("cyl_filt",
                      session = session,
                      choices = unique(mtcars$cyl),
                      selected = unique(mtcars$cyl)[1])

    filt_mtcars <- reactive(mtcars |> filter(cyl == input$cyl_filt))

    return(filt_mtcars)


  })
}



# Cicerone ----------------------------------------------------------------

guide <- Cicerone$
  new()$
  step(el = "mainTabs",
       "Main Tabs",
       "These are the main tabs set in the main server")$
  step(el = "tab1-subTabs",
       "Sub Tabs",
       "These are the subtabs under Tab1")$
  step(el = "tab1-chart_1-chart",
       "Chart",
       "This is a chart!")$
  step(el = "tab1-table_1-table", #This step does not work
       "Table",
       "This is a table!",
       tab = "table_1",
       tab_id = "tab1-table_1")$
  step(el = "tab1-table_1-table-cyl_filt", #This step does not work
       "Filters",
       "Here you can filter the table by number of cylinders.")




# Main app ----------------------------------------------------------------

ui <- fluidPage(
  use_cicerone(),
  mainPanel(
    tabsetPanel(id = "mainTabs",
      tabPanel("tab1", mod_subtabs_ui("tab1")),
      tabPanel("tab2", mod_subtabs_ui("tab2"))
    )
  )
)

server <- function(input, output, session) {

  guide$init()$start()
  
  mod_subtabs_server("tab1")
  mod_subtabs_server("tab2")


}

shinyApp(ui = ui, server = server)
Solution

  • Is it possible that when I am on the first tab, the element in the second tab hasn't been created yet? If so, I don't know how the tab and tab_id arguments would ever work, unless it's due to the hierarchical nature of my modules and tabs.

    Yes, I made three main changes which should make it work using the current development version of cicerone (1.0.5.9000).

    • Your tab and tab_id in the fourth step have to be changed to

      tab = "Table",
tab_id = "tab1-subTabs"

    • The table needs suspendWhenHidden = FALSE:

      outputOptions(output, "tab1-table_1-table", suspendWhenHidden = FALSE)

    • I select the selectInput on the second tab by class because in your app it does not have an id:

      el = ".form-group.shiny-input-container"

    enter image description here

    library(shiny)
library(tidyverse)
library(cicerone)
#packageVersion("cicerone")
#[1] ‘1.0.5.9000’

# Module for subtabs ------------------------------------------------------

mod_subtabs_ui <- function(id){
  ns <- NS(id)
  tagList(
    tabsetPanel(
      id = ns("subTabs"),
      tabPanel("Chart", mod_chart_ui(ns("chart_1"))),
      tabPanel("Table", mod_table_ui(ns("table_1")))
    )
  )
}

mod_subtabs_server <- function(id){
  moduleServer( id, function(input, output, session){
    ns <- session$ns
    
    mod_chart_server("chart_1")
    mod_table_server("table_1")
  })
}


# Module for chart --------------------------------------------------------

mod_chart_ui <- function(id) {
  ns <- NS(id)
  
  tagList(
    plotOutput(ns("chart"))
  )
}

mod_chart_server <- function(id) {
  moduleServer( id, function(input, output, session){
    ns <- session$ns
    
    output$chart <- renderPlot(ggplot(mtcars, aes(x = mpg, y = cyl)) + geom_point())
    
  })
}


# Module for table --------------------------------------------------------

mod_table_ui <- function(id) {
  ns <- NS(id)
  
  tagList(
    sidebarLayout(
      sidebarPanel(
        mod_filter_ui(ns("filter_chart"))),
      mainPanel(
        tableOutput(ns("table"))
      )
    )
  )
}

mod_table_server <- function(id) {
  moduleServer( id, function(input, output, session){
    ns <- session$ns
    
    filt_mtcars <- mod_filter_server("filter_chart")
    
    output$table <- renderTable(filt_mtcars())
    
  })
}


# Module for filter -------------------------------------------------------

mod_filter_ui <- function(id) {
  ns <- NS(id)
  tagList(
    selectInput(ns("cyl_filt"),
                label = "Filter for # of Cylinders",
                choices = NULL)
  )
}

mod_filter_server <- function(id) {
  moduleServer( id, function(input, output, session){
    ns <- session$ns
    
    updateSelectInput("cyl_filt",
                      session = session,
                      choices = unique(mtcars$cyl),
                      selected = unique(mtcars$cyl)[1])
    
    filt_mtcars <- reactive(mtcars |> filter(cyl == input$cyl_filt))
    
    return(filt_mtcars)

  })
}



# Cicerone ----------------------------------------------------------------

guide <- Cicerone$
  new()$
  step(el = "mainTabs",
       "Main Tabs",
       "These are the main tabs set in the main server")$
  step(el = "tab1-subTabs",
       "Sub Tabs",
       "These are the subtabs under Tab1")$
  step(el = "tab1-chart_1-chart",
       "Chart",
       "This is a chart!")$
  step(el = "tab1-table_1-table",
       "Table",
       "This is a table!",
       tab = "Table",
       tab_id = "tab1-subTabs")$
  step(el = ".form-group.shiny-input-container",
       "Filters",
       "Here you can filter the table by number of cylinders.")


# Main app ----------------------------------------------------------------

ui <- fluidPage(
  use_cicerone(),
  mainPanel(
    tabsetPanel(id = "mainTabs",
                tabPanel("tab1", mod_subtabs_ui("tab1")),
                tabPanel("tab2", mod_subtabs_ui("tab2"))
    )
  )
)

server <- function(input, output, session) {
  
  guide$init()$start()
  
  mod_subtabs_server("tab1")
  outputOptions(output, "tab1-table_1-table", suspendWhenHidden = FALSE)
  mod_subtabs_server("tab2")
  
  
}

shinyApp(ui = ui, server = server)