使用 Shiny 中的“rintrojs”创建有关应用程序使用的分步介绍；对话框出现在某些选项卡的左上角，但其他选项卡不显示

Question

我正在使用 rintrojs 包在我的闪亮仪表板应用程序中创建弹出文本框，这将帮助用户了解闪亮应用程序中的功能。我的应用包含多个标签页。

我的问题是，在某些选项卡中，对话框出现在屏幕的左上角。例如，当我激活对话框时，会发生这种情况：-

这发生在第一个和第二个选项卡上。但是，在第三个选项卡上，它正常工作并且符合预期的方式：-

这是我的闪亮代码：-

ui<-fluidPage(
  introjsUI(),
  titlePanel('My dashboard'),
  tabsetPanel(
    
    
    
    #=============================================Firsttab==================================================
    
    tabPanel("First tab", 
             
             
             sidebarLayout(
               sidebarPanel(width = 5,
                            actionButton("help_tab1", "About this Page"),
                            h5("Before you begin any analysis, you may to read this text"),
                            br(),
                            h5("Here is some text that explains some stuff"),
                            introBox(
                              numericInput("numericinput1", "Put a number in here",1000),data.step = 1,
                              data.intro = "You should put a number in this box"),
                            useShinyalert(),
                            #add_busy_spinner(spin = "fading-circle"),
                            introBox(
                              actionButton(inputId = "actionbutton1", "Button"),data.step = 2,
                              data.intro = "Press this button for something to happen")),
               mainPanel(fluidRow(
                 column(5, textOutput("text1")),
                 column(8, textOutput("text2")),
                 
                 column(8, textOutput("text3")),
                 
                 column(8, textOutput("text4")),
                 
                 column(8, h4("Table 1") ,DT::dataTableOutput("table1")),
                 
                 column(8, h4("Table 2") ,DT::dataTableOutput("table2")),
                 
                 column(8,h4("Table 3") , DT::dataTableOutput("table3")),
                 
                 column(8, h4("Table 4"), DT::dataTableOutput("table4")),
                 
                 column(12, h4("Table 5"),DT::dataTableOutput("table5")))))),#end of tab panel
    
    #==================================================================Secondtab===========================================
    tabPanel("Second tab",
             sidebarPanel(width = 4,
                          
                          actionButton("help_tab2", "About this Page"),
                          h5("Here is some text"),
                          introBox(
                            numericInput("numericinput2","Put a number in here",5), data.step = 1, 
                            data.intro = "Put a number in this box"),
                          br(),
                          h5("Some more text"),
                          introBox( 
                            numericInput("numericinput3", "Put a number in here", 100), data.step = 2,
                            data.intro = "Put a number in this box"),
                          h5("Here is some text"),
                          introBox( 
                            actionButton("actionbutton2", "Button"), data.step = 3, 
                            data.intro = "Something will happen if you press this button")),
             mainPanel(
               textOutput("text5"),
               h4("Plot 1"),
               plotOutput("plot1", width = "100%"),
               h4("Plot 2"),
               plotOutput("plot2",width = "100%"),
               h4("Plot 3"),
               plotOutput("plot3",width="100%"))),#end of tab
    
    #===================================================================================Thirdtab=================================
   
    
    tabPanel("Third tab",
             sidebarPanel(width = 4,
                          
                          actionButton("help_tab3", "About this Page"),
                          h5("Here is some text"),
                          introBox(
                            numericInput("numericinput4","Put a number in here",5), data.step = 1, 
                            data.intro = "Put a number in this box"),
                          br(),
                          h5("Some more text"),
                          introBox( 
                            numericInput("numericinput5", "Put a number in here", 100), data.step = 2,
                            data.intro = "Put a number in this box"),
                          h5("Here is some text"),
                          introBox( 
                            actionButton("actionbutton3", "Button"), data.step = 3, 
                            data.intro = "Something will happen if you press this button")),
             mainPanel(
               textOutput("text6"),
               h4("Plot 4"),
               plotOutput("plot4", width = "100%"),
               h4("Plot 5"),
               plotOutput("plot5",width = "100%"),
               h4("Plot 6"),
               plotOutput("plot6",width="100%")))))



server <- function(input, output, session) {
  
  observeEvent(input$help_tab1,
               introjs(session, options = list("showBullets"="false", "showProgress"="true", 
                                               "showStepNumbers"="false","nextLabel"="Next","prevLabel"="Prev","skipLabel"="Skip"))
  )
  
  observeEvent(input$help_tab2,
               introjs(session, options = list("showBullets"="false", "showProgress"="true", 
                                               "showStepNumbers"="false","nextLabel"="Next","prevLabel"="Prev","skipLabel"="Skip"))
  )
  
  observeEvent(input$help_tab3,
               introjs(session, options = list("showBullets"="false", "showProgress"="true", 
                                               "showStepNumbers"="false","nextLabel"="Next","prevLabel"="Prev","skipLabel"="Skip"))
  )
  
}

shinyApp(ui,server)

如何使此功能在 first/second 选项卡中工作，因为它在第三个选项卡中工作？这是我第一次使用此功能，因此将不胜感激。

Answer 1

我在数据框中添加了您的“介绍”，并在特定选项卡的反应式中对项目进行了子集化。下面是一个工作示例：

library(shiny)
library(rintrojs)
ui<-fluidPage(
  introjsUI(),
  titlePanel('My dashboard'),
  tabsetPanel(
    #=============================================Firsttab==================================================
    tabPanel(
      "First tab",
      sidebarLayout(
        sidebarPanel(
          width = 5,
          actionButton("help_tab1", "About this Page"),
          h5("Before you begin any analysis, you may to read this text"),
          br(),
          h5("Here is some text that explains some stuff"),
          numericInput("numericinput1", "Put a number in here",1000),
          actionButton(inputId = "actionbutton1", "Button")),
        mainPanel(
          fluidRow(
            column(5, textOutput("text1"))
          )
        )
      )
    ),
    
    #==================================================================Secondtab===========================================
    tabPanel(
      "Second tab",
      sidebarPanel(
        width = 4,
        actionButton("help_tab2", "About this Page"),
        h5("Here is some text"),
        numericInput("numericinput2","Put a number in here",5), 
        br(),
        h5("Some more text")
      ),
      
      mainPanel(
        textOutput("text5")
      )
    ),#end of tab
    
    #===================================================================================Thirdtab=================================
    tabPanel(
      "Third tab",
      sidebarPanel(
        width = 4,
        actionButton("help_tab3", "About this Page"),
        h5("Here is some text op tab 3"),
        numericInput("numericinput4","Put a number in here",3), 
        br(),
        h5("Some more text"),
        mainPanel(
          textOutput("text6")
        )
      )
    )
  )
)



server <- function(input, output, session) {
  
  help_text <- reactive({
    if (input$help_tab1) whichtab <- "help_tab1"
    if (input$help_tab2) whichtab <- "help_tab2"
    if (input$help_tab3) whichtab <- "help_tab3"
    subset(helptext, tab == whichtab)
  })
  
  observeEvent(input$help_tab1,
               introjs(session, options = list("showBullets"="false", "showProgress"="true", 
                                               "showStepNumbers"="false","nextLabel"="Next","prevLabel"="Prev","skipLabel"="Skip", steps=help_text()))
  )
  
  observeEvent(input$help_tab2,
               introjs(session, options = list("showBullets"="false", "showProgress"="true", 
                                               "showStepNumbers"="false","nextLabel"="Next","prevLabel"="Prev","skipLabel"="Skip", steps=help_text()))
  )
  
  observeEvent(input$help_tab3,
               introjs(session, options = list("showBullets"="false", "showProgress"="true", 
                                               "showStepNumbers"="false","nextLabel"="Next","prevLabel"="Prev","skipLabel"="Skip", steps=help_text()))
  )
  
}

helptext <- data.frame(
  tab = c("help_tab1", "help_tab1", "help_tab2", "help_tab3")
  , step = c(1,2,1,1)
  , element = c("#numericinput1", "#actionbutton1", "#numericinput2", "#numericinput4")
  , intro = c("You should put a number in this box","Press this button for something to happen","Put a number in this box","Put a number in this box")
)


shinyApp(ui,server)

也可以为每个选项卡指定一个特定的 ID，这样您就知道选择了哪个选项卡。您可以制作一个通用的通用帮助按钮（而不是每页一个）。

Answer 2

基于 Roelof 的回答，但处理的是边缘情况。

library(shiny)
library(rintrojs)
library(data.table)

ui<-fluidPage(
  introjsUI(),
  titlePanel('My dashboard'),
  tabsetPanel(
    #=============================================Firsttab==================================================
    tabPanel(
      "First tab",
      sidebarLayout(
        sidebarPanel(
          width = 5,
          actionButton("help_tab1", "About this Page"),
          h5("Before you begin any analysis, you may to read this text"),
          br(),
          h5("Here is some text that explains some stuff"),
          numericInput("numericinput1", "Put a number in here",1000),
          actionButton(inputId = "actionbutton1", "Button")),
        mainPanel(
          fluidRow(
            column(5, textOutput("text1"))
          )
        )
      )
    ),
    
    #==================================================================Secondtab===========================================
    tabPanel(
      "Second tab",
      sidebarPanel(
        width = 4,
        actionButton("help_tab2", "About this Page"),
        h5("Here is some text"),
        numericInput("numericinput2","Put a number in here",5), 
        br(),
        h5("Some more text")
      ),
      
      mainPanel(
        textOutput("text5")
      )
    ),#end of tab
    
    #===================================================================================Thirdtab=================================
    tabPanel(
      "Third tab",
      sidebarPanel(
        width = 4,
        actionButton("help_tab3", "About this Page"),
        h5("Here is some text op tab 3"),
        numericInput("numericinput4","Put a number in here",3), 
        br(),
        h5("Some more text"),
        mainPanel(
          textOutput("text6")
        )
      )
    )
  )
)



server <- function(input, output, session) {
  
  helptext <- reactive(data.table(
    tab = c("help_tab1", "help_tab1", "help_tab2", "help_tab3"),
    step = c(1,2,1,1),
    element = c("#numericinput1", "#actionbutton1", "#numericinput2", "#numericinput4"),
    intro = c("You should put a number in this box","Press this button for something to happen","Put a number in this box","Put a number in this box")
  ))
  
  observeEvent(
    eventExpr = input$help_tab1,
    handlerExpr = {
      introjs(session, 
              options = list(
                "showBullets"="false", "showProgress"="true", 
                "showStepNumbers"="false","nextLabel"="Next","prevLabel"="Prev","skipLabel"="Skip",
                steps=helptext()[tab == "help_tab1"]
              )
      )
    }
  )
  
  observeEvent(
    eventExpr = input$help_tab2,
    handlerExpr = {
      introjs(session, 
              options = list(
                "showBullets"="false", "showProgress"="true", 
                "showStepNumbers"="false","nextLabel"="Next","prevLabel"="Prev","skipLabel"="Skip",
                steps=helptext()[tab == "help_tab2"]
              )
      )
    }
  )
  
  observeEvent(
    eventExpr = input$help_tab3,
    handlerExpr = {
      introjs(session, 
              options = list(
                "showBullets"="false", "showProgress"="true", 
                "showStepNumbers"="false","nextLabel"="Next","prevLabel"="Prev","skipLabel"="Skip",
                steps=helptext()[tab == "help_tab3"]
              )
      )
    }
  )
  
}



shinyApp(ui,server)

使用 Shiny 中的“rintrojs”创建有关应用程序使用的分步介绍；对话框出现在某些选项卡的左上角，但其他选项卡不显示

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

r

shinydashboard

shinyapps