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

编程问答 2022-05-15

问题描述

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

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

enter image description here

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

enter image description here

这是我闪亮的代码：-

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")),textoutput("text3")),textoutput("text4")),h4("Table 1"),DT::dataTableOutput("table1")),h4("Table 2"),DT::dataTableOutput("table2")),h4("Table 3"),DT::dataTableOutput("table3")),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",h5("Here is some text"),introBox(
                            numericInput("numericinput2",5),data.intro = "Put a number in this Box"),h5("Some more text"),introBox( 
                            numericInput("numericinput3",100),introBox( 
                            actionButton("actionbutton2",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",h4("Plot 3"),plotOutput("plot3",width="100%"))),#end of tab
    
    #===================================================================================Thirdtab=================================
   
    
    tabPanel("Third tab",actionButton("help_tab3",introBox(
                            numericInput("numericinput4",introBox( 
                            numericInput("numericinput5",introBox( 
                            actionButton("actionbutton3",mainPanel(
               textoutput("text6"),h4("Plot 4"),plotOutput("plot4",h4("Plot 5"),plotOutput("plot5",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,"skipLabel"="Skip"))
  )
  
  observeEvent(input$help_tab3,"skipLabel"="Skip"))
  )
  
}

shinyApp(ui,server)

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

解决方法

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

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",h5("Here is some text"),numericInput("numericinput2",5),h5("Some more text")
      ),mainPanel(
        textOutput("text5")
      )
    ),#end of tab
    
    #===================================================================================Thirdtab=================================
    tabPanel(
      "Third tab",actionButton("help_tab3",h5("Here is some text op tab 3"),numericInput("numericinput4",3),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,steps=help_text()))
  )
  
  observeEvent(input$help_tab3,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，以便您知道选择了哪个选项卡。您可以制作一个通用的帮助按钮（而不是每页一个）。

rrshinyappsshinydashboard