Add Tooltip to Tabs in Shiny

问题:

I am trying to add tooltips/popovers using the shinyBS package for a Shiny application but am having an issue due to tabs don't have input/ids. This is preventing the tooltip from firing. Any thoughts?

library(shiny)
library(shinyBS)

    shinyApp(
      ui = tagList(
         navbarPage(
           theme = "cerulean",  # <--- To use a theme, uncomment this
          "shinythemes",
          tabPanel(id="test","Navbar 1",
                   bsTooltip("test", title="Test Title", trigger = "hover"),
                   sidebarPanel(
                     fileInput("file", "File input:"),
                     textInput("txt", "Text input:", "general"),
                     sliderInput("slider", "Slider input:", 1, 100, 30),
                     tags$h5("Deafult actionButton:"),
                     actionButton("action", "Search"),

                     tags$h5("actionButton with CSS class:"),
                     actionButton("action2", "Action button", class = "btn-primary")
                   ),
                   mainPanel(
                     tabsetPanel(
                       tabPanel("Tab 1",
                                bsTooltip("Tab 1", title="Test Title"),
                                h4("Table"),
                                tableOutput("table"),
                                h4("Verbatim text output"),
                                verbatimTextOutput("txtout"),
                                h1("Header 1"),
                                h2("Header 2"),
                                h3("Header 3"),
                                h4("Header 4"),
                                h5("Header 5")
                       ),
                       tabPanel("Tab 2"),
                       tabPanel("Tab 3")
                     )
                   )
          ),
          tabPanel("Navbar 2"),
          tabPanel("Navbar 3")
        )
      ),
      server = function(input, output) {
        output$txtout <- renderText({
          paste(input$txt, input$slider, format(input$date), sep = ", ")
        })
        output$table <- renderTable({
          head(cars, 4)
        })
      }
    )

Attached is a test application using TabPanels and Tabset Panels for testing.

回答1:

Here is a minimal example that adds a tooltip to forst tab

library(shiny)
library(shinyBS)

shinyApp(
  ui = tagList(
    navbarPage(
      theme = "cerulean",  # <--- To use a theme, uncomment this
      "shinythemes",
      tabPanel(id="test","Navbar 1",
               bsTooltip("test", title="Test Title", trigger = "hover"),
               sidebarPanel(
                 fileInput("file", "File input:"),
                 textInput("txt", "Text input:", "general"),
                 sliderInput("slider", "Slider input:", 1, 100, 30),
                 tags$h5("Deafult actionButton:"),
                 actionButton("action", "Search"),

                 tags$h5("actionButton with CSS class:"),
                 actionButton("action2", "Action button", class = "btn-primary")
               ),
               mainPanel(
                 tabsetPanel(
                   tabPanel("Tab 1",
                            bsTooltip("Tab 1", title="Test Title"),
                            div(id = "my_id",                       #changed
                                h4("Table"),
                                tableOutput("table"),
                                h4("Verbatim text output"),
                                verbatimTextOutput("txtout"),
                                h1("Header 1"),
                                h2("Header 2"),
                                h3("Header 3"),
                                h4("Header 4"),
                                h5("Header 5")
                            ),                                      # changed
                            bsTooltip('my_id','some text...')       # changed
                   ),
                   tabPanel("Tab 2"),
                   tabPanel("Tab 3")
                 )
               )
      ),
      tabPanel("Navbar 2"),
      tabPanel("Navbar 3")
    )
  ),
  server = function(input, output) {
    output$txtout <- renderText({
      paste(input$txt, input$slider, format(input$date), sep = ", ")
    })
    output$table <- renderTable({
      head(cars, 4)
    })
  }
)

As you can see, I have only changed 3 lines

• The first and the second line wraps the contents of the first tab inside a div. The div has an id my_id which will be used later
• The third line adds the tooltip by using the div id

Basycally, you should be able to wrap whatever content you want into a div, give it an id and then add a popover. If you run into any problems with this approach, please let me know.

回答2:

you can use HTML wenn passing the Title of the Tabs. in this case I just pt the title in a span and added the attribute titlewhich is the attribute HTML uses default for mouse-overs. For me this is much sinpler the trying to add it over shinyBS.

library(shiny)
library(shinyBS)

shinyApp(
  ui = tagList(
    navbarPage(
      theme = "cerulean",  # <--- To use a theme, uncomment this
      "shinythemes",
      tabPanel(id="test",span("Navbar 1",title="Test Title"),
               sidebarPanel(
                 fileInput("file", "File input:"),
                 textInput("txt", "Text input:", "general"),
                 sliderInput("slider", "Slider input:", 1, 100, 30),
                 tags$h5("Deafult actionButton:"),
                 actionButton("action", "Search"),

                 tags$h5("actionButton with CSS class:"),
                 actionButton("action2", "Action button", class = "btn-primary")
               ),
               mainPanel(
                 tabsetPanel(
                   tabPanel(span("Tab 1", title="Test Title"),
                            h4("Table"),
                            tableOutput("table"),
                            h4("Verbatim text output"),
                            verbatimTextOutput("txtout"),
                            h1("Header 1"),
                            h2("Header 2"),
                            h3("Header 3"),
                            h4("Header 4"),
                            h5("Header 5")
                   ),
                   tabPanel("Tab 2"),
                   tabPanel("Tab 3")
                 )
               )
      ),
      tabPanel("Navbar 2"),
      tabPanel("Navbar 3")
    )
  ),
  server = function(input, output) {
    output$txtout <- renderText({
      paste(input$txt, input$slider, format(input$date), sep = ", ")
    })
    output$table <- renderTable({
      head(cars, 4)
    })
  }
)