Добавить всплывающую подсказку на вкладки в Shiny

Question

Я пытаюсь добавить всплывающие подсказки / всплывающие окна, используя пакет поступивший блеск для приложения Shiny, но у меня возникла проблема из-за того, что на вкладках нет ввода / идентификаторов. Это предотвращает срабатывание подсказки. Какие-нибудь мысли?

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)
        })
      }
    )

Прикреплено тестовое приложение, использующее TabPanels и Tabset Panels для тестирования.

Answer 1

Вы можете использовать HTML, передавая заголовок вкладок. в этом случае я просто добавляю заголовок в промежуток и добавляю атрибут title, который HTML использует по умолчанию для наведения мыши. Для меня это гораздо сложнее, чем пытаться добавить его поверх SharpBS.

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)
    })
  }
)

Answer 2

Вот минимальный пример, который добавляет всплывающую подсказку к первой вкладке

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)
    })
  }
)

Как видите, я изменил только 3 строки

• Первая и вторая строки оборачивают содержимое первой вкладки внутри div. У div есть идентификатор my_id который будет использоваться позже
• Третья строка добавляет всплывающую подсказку, используя div id

По сути, вы должны иметь возможность обернуть любой контент, который вы хотите в div, дать ему идентификатор, а затем добавить всплывающее окно. Если у вас возникнут проблемы с этим подходом, пожалуйста, дайте мне знать.