I'm trying to create a introduction with pop-up text boxes using "rintrojs" package. The thing is that I am using modules with golem in my app, so there is one module per each tab.
The problem i'm getting is that when running the app and clicking the button to display the introduction, the 2 dialog boxes appear at the top left corner of the screen. I'm having the same issue as reported here: Using the ‘rintrojs’ in Shiny to create e step-by-step introductions on app usage; dialog box appears top left corner for some tabs but not others
The difference is that I'm working with modules and the solution proposed here (https://stackoverflow.com/a/70162738/14615249) doesn't work for me.
Here is the problem: enter image description here
And here is some reproducible code so it gets easier to understand:
library(shiny)
library(rintrojs)
library(shinyWidgets)
# UI Module 1
mod_module1_ui <- function(id){
ns <- NS(id)
tagList(
rintrojs::introjsUI(),
column(
width = 12,
actionButton(
inputId = ns("bt"),
label = "Display Button"
)
),
div(
sidebarPanel(
style = "height: 100px;",
width = 12,
shiny::column(
width = 3,
rintrojs::introBox(
shiny::numericInput(
inputId = ns("numeric"),
label = "Numeric Input",
value = 45
),
data.step = 1,
data.intro = div(
h5("Description goes here")
)
),
),
shiny::column(
width = 3,
rintrojs::introBox(
shinyWidgets::pickerInput(
inputId = ns("picker"),
label = "Picker Input",
choices = c(1, 2, 3, 4, 5)
),
data.step = 2,
data.intro = div(
h5("Description goes here")
)
),
),
),
),
)
}
# SERVER Module 1
mod_module1_server <- function(id){
moduleServer( id, function(input, output, session){
ns <- session$ns
observeEvent(input$bt, rintrojs::introjs(session))
})
}
# UI Module 2
mod_module2_ui <- function(id){
ns <- NS(id)
tagList(
rintrojs::introjsUI(),
column(
width = 12,
actionButton(
inputId = ns("bt"),
label = "Display Button"
)
),
div(
sidebarPanel(
style = "height: 100px;",
width = 12,
shiny::column(
width = 3,
rintrojs::introBox(
shiny::numericInput(
inputId = ns("numeric"),
label = "Numeric Input",
value = 45
),
data.step = 1,
data.intro = div(
h5("Description goes here")
)
),
),
shiny::column(
width = 3,
rintrojs::introBox(
shinyWidgets::pickerInput(
inputId = ns("picker"),
label = "Picker Input",
choices = c(1, 2, 3, 4, 5)
),
data.step = 2,
data.intro = div(
h5("Description goes here")
)
),
),
),
),
)
}
# SERVER Module 2
mod_module2_server <- function(id){
moduleServer( id, function(input, output, session){
ns <- session$ns
observeEvent(input$bt, rintrojs::introjs(session))
})
}
# APP UI
app_ui <- function(request) {
tagList(
shiny::navbarPage(
title = ("Example"),
fluid = TRUE,
# 1 - Tab 1 ----
tabPanel(
title = "tab1",
shinydashboard::dashboardHeader(
title = span(
h1("Title tab 1")
)
),
shinydashboard::dashboardBody(
mod_module1_ui("module1_1")
),
),
# 2 - Tab 2 ----
shiny::tabPanel(
title = "tab2",
shinydashboard::dashboardHeader(
title = h1("Title tab 2")
),
shinydashboard::dashboardBody(
mod_module2_ui("module2_1")
),
),
)
)
}
# APP SERVER
app_server <- function(input, output, session) {
mod_module1_server("module1_1")
mod_module2_server("module2_1")
}
shinyApp(app_ui, app_server)
Is there a way to solve this?
Ps: This is my first ever question here in StackOverFlow, so I'd like to apologize in advance if I'm missing important parts of how to ask the question. Thank you!
This problem was addressed in this Github issue but I write a summary and a similar solution here.
rintrojs works by adding attributes to the HTML elements you want to highlight. For example, it adds data-step=1 as an attribute of the numeric input. The problem is that if you create multiple tours, there will be several elements with the attribute data-step=1, which means that rintrojs will not be able to know which one is the "true first step". This is why only the page top left corner is highlighted.
One solution (detailed in the issue I referred to) is to create the list of steps in the server of each module. Therefore, each time the server part of the module will be called, it will reset the steps of rintrojs, so that there is only one data-step=1 for example.
Here's your example adapted:
library(shiny)
library(rintrojs)
library(shinyWidgets)
# UI Module 1
mod_module1_ui <- function(id){
ns <- NS(id)
tagList(
rintrojs::introjsUI(),
column(
width = 12,
actionButton(
inputId = ns("bt"),
label = "Display Button"
)
),
div(
sidebarPanel(
style = "height: 100px;",
width = 12,
shiny::column(
width = 3,
shiny::numericInput(
inputId = ns("numeric"),
label = "Numeric Input",
value = 45
)
),
shiny::column(
width = 3,
div(
id = ns("mypicker"),
shinyWidgets::pickerInput(
inputId = ns("picker"),
label = "Picker Input",
choices = c(1, 2, 3, 4, 5)
)
)
),
),
)
)
}
# SERVER Module 1
mod_module1_server <- function(id){
moduleServer( id, function(input, output, session){
ns <- session$ns
intro <- reactive({
data.frame(
element = paste0("#", session$ns(c("numeric", "mypicker"))),
intro = paste(c("Slider", "Button"), id)
)
})
observeEvent(input$bt, rintrojs::introjs(session, options = list(steps = intro())))
})
}
# UI Module 2
mod_module2_ui <- function(id){
ns <- NS(id)
tagList(
column(
width = 12,
actionButton(
inputId = ns("bt"),
label = "Display Button"
)
),
div(
sidebarPanel(
style = "height: 100px;",
width = 12,
shiny::column(
width = 3,
shiny::numericInput(
inputId = ns("numeric"),
label = "Numeric Input",
value = 45
)
),
shiny::column(
width = 3,
div(
id = ns("mypicker"),
shinyWidgets::pickerInput(
inputId = ns("picker"),
label = "Picker Input",
choices = c(1, 2, 3, 4, 5)
)
)
),
),
),
)
}
# SERVER Module 2
mod_module2_server <- function(id){
moduleServer( id, function(input, output, session){
ns <- session$ns
intro <- reactive({
data.frame(
element = paste0("#", session$ns(c("numeric", "mypicker"))),
intro = paste(c("Slider", "Button"), id)
)
})
observeEvent(input$bt, rintrojs::introjs(session, options = list(steps = intro())))
})
}
# APP UI
app_ui <- function(request) {
tagList(
shiny::navbarPage(
title = ("Example"),
fluid = TRUE,
# 1 - Tab 1 ----
tabPanel(
title = "tab1",
shinydashboard::dashboardHeader(
title = span(
h1("Title tab 1")
)
),
shinydashboard::dashboardBody(
mod_module1_ui("module1_1")
),
),
# 2 - Tab 2 ----
shiny::tabPanel(
title = "tab2",
shinydashboard::dashboardHeader(
title = h1("Title tab 2")
),
shinydashboard::dashboardBody(
mod_module2_ui("module2_1")
),
),
)
)
}
# APP SERVER
app_server <- function(input, output, session) {
mod_module1_server("module1_1")
mod_module2_server("module2_1")
}
shinyApp(app_ui, app_server)
Note that using "picker" in the dataframe containing the steps doesn't really work (only a very small part of the pickerInput is highlighted). This is why I wrap the pickers in div() and use the id of this div() instead.