R语言 将工具提示添加到闪亮的选项卡中

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

附上一个使用 TabPanel 和 Tabset Panel 进行测试的测试应用程序。

Answer 1

您可以在传递选项卡的标题时使用 HTML。在这种情况下，我只是将标题放在span中并添加了属性title这是 HTML 用于鼠标悬停的默认属性。对我来说，这比尝试将其添加到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)
})
}
)

Answer 2

下面是一个将工具提示添加到 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 有一个 idmy_id稍后会用到
• 第三行使用div id 添加工具提示

基本上，您应该能够将您想要的任何内容包装到div 中，给它一个 id，然后添加一个弹出窗口。如果您在使用此方法时遇到任何问题，请告诉我。