问题
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)
})
}
)
来源:https://stackoverflow.com/questions/44953873/add-tooltip-to-tabs-in-shiny