r - 在带有模块(golem)的 Shiny 应用程序中使用 "rintrojs"包时，左上角出现逐步介绍的对话框

Question

我正在尝试使用“rintrojs”包创建带有弹出文本框的介绍。问题是我在我的应用程序中使用带有 golem 的模块，因此每个选项卡都有一个模块。

我遇到的问题是，当运行应用程序并单击按钮以显示介绍时，2 个对话框出现在屏幕的左上角。我遇到了与此处报告的问题相同的问题: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

区别在于我使用的是模块，这里提出的解决方案 ( https://stackoverflow.com/a/70162738/14615249 ) 对我不起作用。

问题来了: enter image description here

下面是一些可重现的代码，因此更容易理解:

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)

有办法解决吗？

Ps:这是我在 StackOverFlow 中的第一个问题，所以如果我遗漏了如何提问的重要部分，我想提前道歉。谢谢!

Answer 1

此问题已在 this Github issue 中解决但我在这里写了一个总结和一个类似的解决方案。

rintrojs 通过向要突出显示的 HTML 元素添加属性来工作。例如，它将 data-step=1 添加为数字输入的属性。问题在于，如果创建多个游览，将会有多个具有 data-step=1 属性的元素，这意味着 rintrojs 将无法知道是哪一个是“真正的第一步”。这就是为什么只突出显示页面左上角的原因。

一个解决方案(在我提到的问题中有详细说明)是在每个模块的服务器中创建步骤列表。因此，每次调用模块的服务器部分时，都会重置 rintrojs 的步骤，例如只有一个 data-step=1。

这是您改编的示例:

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)

请注意，在包含步骤的数据框中使用 "picker" 并没有真正起作用(只有一小部分 pickerInput 被突出显示)。这就是为什么我将选择器包装在 div() 中并改用此 div() 的 id。