Question

我正在尝试使用shinyBS软件包为Shiny应用程序添加工具提示/弹出窗口，但由于标签没有输入/ ID而出现问题。这样可以防止工具提示被触发。有什么想法吗？

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面板进行测试的测试应用程序。

Answer 1

这是一个向forst标签添加工具提示的最小示例

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中，给它一个id，然后添加一个popover。如果您遇到这种方法的任何问题，请告诉我。

Answer 2

您可以使用HTML wenn传递标签的标题。在这种情况下，我只是在一个范围内查看标题并添加属性title，这是HTML使用默认鼠标悬停的属性。对我来说，试图将它添加到有光泽的BS上是非常明智的。

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

在Shiny

2 个答案: