Issue with using rintrojs with multiple instances of the same shiny module

[hschult]

Hi,

There seems to be a problem with calling a shiny module multiple times. If I trigger the introduction it always shows the one from the last instance regardless on which button I click. Here is a minimal example:

library(shiny)
library(shinydashboard)
library(rintrojs)

moduleUI <- function(id, label = NULL){
  ns <- NS(id)

  ui <- tagList(
    introjsUI(),
    introBox(
      sliderInput(ns("slider"), label = label, value = 5, min = 0, max = 10),
      data.step = 1,
      data.intro = paste("Slider", label)
    ),
    introBox(
      actionButton(ns("help"), label = "rintrojs"),
      data.step = 2,
      data.intro = paste("Button", label)
    )
  )

  return(tagList(ui))
}

module <- function(input, output, session){
  observeEvent(input$help, {
    introjs(session)
  })
}

ui <- dashboardPage(header = dashboardHeader(disable = TRUE), sidebar = dashboardSidebar(disable = TRUE),
  dashboardBody(
    fluidPage(
      column(width = 6, moduleUI("id1", label = "module1")),
      column(width = 6, moduleUI("id2", label = "module2"))
    )
  )
)

server <- function(input, output, session){
  callModule(module, "id1")
  callModule(module, "id2")
}

shinyApp(ui, server)

Thanks for looking into this, Hendrik

[carlganz]

Thanks for MRE. I will investigate.

[carlganz]

This actually makes sense. You have created two divs with the attribute data-step=1 and two divs with the attribute data-step=2 so introjs can't parse the order correctly. Your best bet is to use server side processing so this works:

library(shiny)
library(shinydashboard)
library(rintrojs)

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

  ui <- tagList(
    introjsUI(),
    # use div wrapper around slider because ID doesn't identify part you want to highlight
    div(id = ns("box"),
      sliderInput(ns("slider"), label = '', value = 5, min = 0, max = 10)
    ),
      actionButton(ns("help"), label = "rintrojs")
  )

  return(tagList(ui))
}

module <- function(input, output, session, label){

  intro <- reactive(data.frame(element = paste0("#",session$ns(c("box","help"))),
                               intro = paste(c("Slider","Button"), label)))

  observe({
    updateSliderInput(session, "slider", label = label)
  })

  observeEvent(input$help, {
    introjs(session, options = list(steps=intro()))
  })
}

ui <- dashboardPage(header = dashboardHeader(disable = TRUE), sidebar = dashboardSidebar(disable = TRUE),
                    dashboardBody(
                      fluidPage(
                        column(width = 6, moduleUI("id1")),
                        column(width = 6, moduleUI("id2"))
                      )
                    )
)

server <- function(input, output, session){
  callModule(module, "id1", "module1")
  callModule(module, "id2", "module2")
}

shinyApp(ui, server)

[hschult]

Your solution seems to work great, thanks! But in this case I would move the slider completely to the server side so that you don't need to update it.

library(shiny)
library(shinydashboard)
library(rintrojs)

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

  ui <- tagList(
    introjsUI(),
    # no need for a div wrapper anymore
    uiOutput(ns("sliderbox")),
    actionButton(ns("help"), label = "rintrojs")
  )

  return(tagList(ui))
}

module <- function(input, output, session, label){

  intro <- reactive(data.frame(element = paste0("#",session$ns(c("sliderbox","help"))),
                               intro = paste(c("Slider","Button"), label)))

  # just render the slider once rather than render & update
  output$sliderbox <- renderUI({
    sliderInput(session$ns("slider"), label = label, value = 5, min = 0, max = 10)
  })

  observeEvent(input$help, {
    introjs(session, options = list(steps=intro()))
  })
}

ui <- dashboardPage(header = dashboardHeader(disable = TRUE), sidebar = dashboardSidebar(disable = TRUE),
                    dashboardBody(
                      fluidPage(
                        column(width = 6, moduleUI("id1")),
                        column(width = 6, moduleUI("id2"))
                      )
                    )
)

server <- function(input, output, session){
  callModule(module, "id1", "module1")
  callModule(module, "id2", "module2")
}

shinyApp(ui, server)

Sadly this solution will render introBoxes useless to me, as the package I am working on mainly uses modules. Maybe you could use the NS function in the future to create unique id's so there won't be any overwrite, but this may be harder than I think as I'm not familiar with javascript.

Regards, Hendrik