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.
You can use HTML when passing the Title of the Tabs. In this case I just put the title in a span and added the attribute title which is the attribute HTML uses default for mouse-overs. For me this is much simpler than 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)
})
}
)
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.
Related
I would like to start my app with the first tabset panel displayed.
To do this I need to click on TabSet 1 button. How can I let this TabSet displayed without need to click on the TabSet 1 button ?
And also, to do the changing on tabSet Panels I use observeEventfor times. Is this the best practice to do this?
How can I improve the observeEventcode part?
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
actionButton("btn_1", "tabSet 1"),
actionButton("btn_2", "tabSet 2"),
actionButton("btn_3", "tabSet 3"),
actionButton("btn_4", "tabSet 4"),
uiOutput("tabset")
)
server <- function(input, output, session) {
observeEvent(input$btn_1,{
output$tabset <- renderUI({
tabsetPanel(
tabPanel(
h6("TabPanel 1")
),
tabPanel(
h6("TabPanel 2")
),
tabPanel(
h6("TabPanel 3")
),
tabPanel(
h6("TabPanel 4")
)
)
})
})
observeEvent(input$btn_2,{
output$tabset <- renderUI({
tabsetPanel(
tabPanel(
h6("TabPanel 1")
)
)
})
})
observeEvent(input$btn_3,{
output$tabset <- renderUI({
tabsetPanel(
tabPanel(
h6("TabPanel 3")
),
tabPanel(
h6("TabPanel 3")
),
tabPanel(
h6("TabPanel 3")
),
tabPanel(
h6("TabPanel 3")
),
tabPanel(
h6("TabPanel 3")
)
)
})
})
observeEvent(input$btn_4,{
output$tabset <- renderUI({
tabsetPanel(
tabPanel(
h1("LASt Button Title Panel")
)
)
})
})
}
shinyApp(ui, server)
I'd recommend to avoid renderUI when ever you can, as it is slow to re-render all those elements on a button click compared to switching their visibility on and off.
Please read chapter 10 from Mastering Shiny:
That’s because it’s reactive: the app must load, trigger a reactive
event, which calls the server function, yielding HTML to insert into
the page. This is one of the downsides of renderUI(); relying on it
too much can create a laggy UI.
You could use radioButtons and conditionalPanels or simply a nested tabsetPanel to keep the work in the UI part of the app (client side):
library(shiny)
ui <- fluidPage(
tabsetPanel(
tabPanel(
"tabSet 1",
tabsetPanel(tabPanel(h6("TabPanel 1")),
tabPanel(h6("TabPanel 2")),
tabPanel(h6("TabPanel 3")),
tabPanel(h6("TabPanel 4"))
)
),
tabPanel("tabSet 2",
tabsetPanel(tabPanel(h6(
"TabPanel 1"
)))
),
tabPanel(
"tabSet 3",
tabsetPanel(
tabPanel(h6("TabPanel 3")),
tabPanel(h6("TabPanel 3")),
tabPanel(h6("TabPanel 3")),
tabPanel(h6("TabPanel 3")),
tabPanel(h6("TabPanel 3"))
)
),
tabPanel("tabSet 4",
tabsetPanel(tabPanel(
h1("LASt Button Title Panel")
))
)
)
)
server <- function(input, output, session) {}
shinyApp(ui, server)
I want to hide a tabsetPanel in a ShinyApp. Following this answer in a Shiny issue I can do that just fine like this:
library(shiny)
ui <- fluidPage(
tags$style("#inTabset { display:none; }"), #This works
sidebarLayout(
sidebarPanel(
sliderInput("controller", "Controller", 1, 3, 1)
),
mainPanel(
tabsetPanel(id = "inTabset",
tabPanel(title = "Panel 1", value = "panel1", "Panel 1 content"),
tabPanel(title = "Panel 2", value = "panel2", "Panel 2 content"),
tabPanel(title = "Panel 3", value = "panel3", "Panel 3 content")
)
)
)
)
server <- function(input, output, session) {
observeEvent(input$controller, {
updateTabsetPanel(session, "inTabset", selected = paste0("panel", input$controller))
})
}
shinyApp(ui, server)
However, I'm using bslib for theming. This library seems to modify the css selectors involved and I can't seem to figure out how to modify the tabsetPanel selector to hide it:
library(shiny)
library(bslib)
ui <- fluidPage(
theme = bs_theme(primary = "#EA80FC"),
tags$style("#inTabset { display:none; }"), #This no longer works,
sidebarLayout(
sidebarPanel(
sliderInput("controller", "Controller", 1, 3, 1)
),
mainPanel(
tabsetPanel(id = "inTabset",
tabPanel(title = "Panel 1", value = "panel1", "Panel 1 content"),
tabPanel(title = "Panel 2", value = "panel2", "Panel 2 content"),
tabPanel(title = "Panel 3", value = "panel3", "Panel 3 content")
)
)
)
)
server <- function(input, output, session) {
observeEvent(input$controller, {
updateTabsetPanel(session, "inTabset", selected = paste0("panel", input$controller))
})
}
shinyApp(ui, server)
I tried inspecting and playing with the elements shown in chrome's dev console to no avail. So, how do I reference this element when using bslib?
Not sure what's the reason you want to hide the tabs via CSS when you could achieve the same result via type="hidden" which also seems to work fine with bslib:
library(shiny)
library(bslib)
ui <- fluidPage(
theme = bs_theme(primary = "#EA80FC"),
sidebarLayout(
sidebarPanel(
sliderInput("controller", "Controller", 1, 3, 1)
),
mainPanel(
tabsetPanel(id = "inTabset",
type = "hidden",
tabPanel(title = "Panel 1", value = "panel1", "Panel 1 content"),
tabPanel(title = "Panel 2", value = "panel2", "Panel 2 content"),
tabPanel(title = "Panel 3", value = "panel3", "Panel 3 content")
)
)
)
)
server <- function(input, output, session) {
observeEvent(input$controller, {
updateTabsetPanel(session, "inTabset", selected = paste0("panel", input$controller))
})
}
shinyApp(ui, server)
#>
#> Listening on http://127.0.0.1:3626
I have at least 2 individual apps that I want to join in one single app. Although I was using shinyDashboard, I think that it could be a good idea to try with navbarPage.
However, I don't know if it is possible to do what I want with this new approach.
To put you in a context, this is an example of my shinyDashboard. Each tab has a sidebarPanel and mainPanel. I replicated the info in all the tabs, but the idea is that each tab has different things.
However, I was thinking to have this using navbarPage. Do you know if it is possible?
Here I attach you the code that I used for the shinyDashboard:
library(shiny)
library(shinydashboard)
library(shinyWidgets)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
## Sidebar content
dashboardSidebar(
sidebarMenu(
menuItem("Tab1", tabName = "Tab1", icon = icon("th")),
menuItem("Tab2", tabName = "Tab2", icon = icon("th")),
menuItem("Tab3", tabName = "Tab3", icon = icon("th"))
)
),
dashboardBody(
fluidRow(
tabItems(
tabItem(tabName = "Tab1",
sidebarPanel(
numericInput("num",
"Select a number",
min = 1,
value = 10),
checkboxInput("remove", "Remove...", value = FALSE),
sliderInput("slider", "slider", min = 1, max = 30, value=22)
),
mainPanel(
plotOutput("plot1")
)
),
tabItem(tabName = "Tab2",
sidebarPanel(
numericInput("num2",
"Select a number",
min = 1,
value = 10),
checkboxInput("remove2", "Remove...", value = FALSE),
sliderInput("slider2", "slider", min = 1, max = 30, value=22)
),
mainPanel(
plotOutput("plot2")
)
),
tabItem(tabName = "Tab3",
sidebarPanel(
numericInput("num3",
"Select a number",
min = 1,
value = 10),
checkboxInput("remove3", "Remove...", value = FALSE),
sliderInput("slider3", "slider", min = 1, max = 30, value=22)
),
mainPanel(
plotOutput("plot3")
)
)
)
)
)
)
server <- function(input, output, session) {
output$plot1 <- renderPlot({
plot(x=c(1,2,3,4,5,6), y=c(14,3,6,4,56,2))
})
output$plot2 <- renderPlot({
plot(x=c(1,2,3,4,5,6), y=c(14,3,6,4,56,2))
})
output$plot3 <- renderPlot({
plot(x=c(1,2,3,4,5,6), y=c(14,3,6,4,56,2))
})
}
shinyApp(ui, server)
And the code for the navbarPage approach:
library(shinythemes)
library(shiny)
ui <- fluidPage(theme = shinytheme("flatly"),
navbarPage(
collapsible = T,
fluid = T,
"",
tabPanel("Tab 1", "one"),
tabPanel("Tab 2", "two"),
tabPanel("Tab 3", "three"),
)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
Thanks very much in advance
You can do that with sidebarLayout. Here I've done it for the first tabPanel:
library(shinythemes)
library(shiny)
ui <- fluidPage(
theme = shinytheme("flatly"),
navbarPage(
title = "Your App Title",
collapsible = TRUE,
fluid = TRUE,
tabPanel(
title = "Tab 1",
sidebarLayout(
sidebarPanel = sidebarPanel(
tags$h3(
"Sidebar Content Here!"
)
),
mainPanel = mainPanel(
tags$h3(
"Main Panel Content Here!"
)
)
)
),
tabPanel(
title = "Tab 2",
"three"
),
)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
I want to display inputs (checkboxes, select input) in the sidebar of my shiny dashboard, but only when a certain tab is clicked.
Minimum reporducible example below. How can I get the checkboxes and select input to only show up when on Page 2?
#ui.R
library(shiny)
library(shinydashboard)
# Define UI for application that draws a histogram
shinyUI(dashboardPage(
dashboardHeader(title = "Test Application",
titleWidth = "400px"
),
dashboardSidebar(
id = "navbar",
menuItem("Page 1", tabName = "page1"),
menuItem("Page 2", tabName = "page2"),
# THESE SHOW UP ALL THE TIME - HOW TO GET JUST ON PAGE 2?
checkboxGroupInput("outcome", "Select Outcome Variable(s):", choices = c("Box 1", "Box 2", "Box 3")),
selectInput("selectinput", label = "Select:", choices = c("Choice 1", "Choice 2", "Choice 2"))
),
dashboardBody(
tabItems(
tabItem(
tabName = "page1",
h1("This is page 1")
),
tabItem(
tabName = "page2",
h1("This is page 2")
)
)
)
))
I assume something is needed in here to make the inputs dynamic?
# server.R
library(shiny)
# Define server logic required to draw a histogram
shinyServer(function(input, output) {
})
ANSWER: use a conditional panel that queries the selected tab.
Credit: Mine at Rstudio
library(shiny)
library(shinydashboard)
# ui ---------------------------------------------------------------------------
ui <- dashboardPage(
# title ----
dashboardHeader(title = "Test Application"),
# sidebar ----
dashboardSidebar(
sidebarMenu(id = "sidebarid",
menuItem("Page 1", tabName = "page1"),
menuItem("Page 2", tabName = "page2"),
conditionalPanel(
'input.sidebarid == "page2"',
sliderInput("bins", "Number of bins:", min = 1, max = 50, value = 30),
selectInput("title", "Select plot title:", choices = c("Hist of x", "Histogram of x"))
)
)
),
# body ----
dashboardBody(
tabItems(
# page 1 ----
tabItem(tabName = "page1", "Page 1 content. This page doesn't have any sidebar menu items."),
# page 2 ----
tabItem(tabName = "page2",
"Page 2 content. This page has sidebar meny items that are used in the plot below.",
br(), br(),
plotOutput("distPlot"))
)
)
)
# server -----------------------------------------------------------------------
server <- function(input, output, session) {
output$distPlot <- renderPlot({
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x, breaks = bins, col = "darkgray", border = "white", main = input$title)
})
}
# shiny app --------------------------------------------------------------------
shinyApp(ui, server)
If I understood your question correctly, all you need to do is the following:
When defining the dashboardSidebar if you just want it as a navigational panel add sidebarmenu() and then add your menu items.
Then to have the checkboxes and select input appear only for the main dashboard on page 2 add it under dashboardbody() with the tabItem = "page2". See below:
#ui.R
library(shiny)
library(shinydashboard)
# Define UI for application that draws a histogram
ui<- dashboardPage(
dashboardHeader(title = "Test Application",titleWidth = "400px"),
dashboardSidebar(
sidebarMenu( #Add sidebarMenu here!!!!!
menuItem("Page 1", tabName = "page1", icon = icon("dashboard")), # You can add icons to your menu if you want
menuItem("Page 2", tabName = "page2", icon = icon("dashboard")))),
dashboardBody(
tabItems(
tabItem(
tabName = "page1",
h1("This is page 1")),
tabItem( #Add checkboxGroupInput into this tabItem
tabName = "page2",
h1("This is page 2"),
checkboxGroupInput("outcome", "Select Outcome Variable(s):", choices = c("Box 1", "Box 2", "Box 3")),
selectInput("selectinput", label = "Select:", choices = c("Choice 1", "Choice 2", "Choice 2")))
)
))
server <- function(input,output,session) {
}
shinyApp(ui, server)
I'm trying to do a presentation of my shiny app with the package rintrojs. This works well when I use it on actionButton or things like that but I would like to use it on the names of tabPanels.
I don't want to present something display in the panels, I want to have an intro box on the name of the panels. However, when doing this, the tabPanels do not display anymore. How should I do it?
Here's a reproducible example:
library(shiny)
library(rintrojs)
ui <- navbarPage(
title = "foo",
introjsUI(),
tabPanel(
introBox(title = "Panel 1",
data.step = 1,
data.intro = "This is Panel 1"),
fluidRow(actionButton("button1", "Button 1"))
),
tabPanel(
introBox(title = "Panel 2",
data.step = 2,
data.intro = "This is Panel 2"),
fluidRow(actionButton("button2", "Button 2"))
)
# If you want to see a "normal" app, comment from "introjsUI()" to here, and uncomment the chunk below
# tabPanel(title = "Panel 1",
# fluidRow(actionButton("button1", "Button 1"))
# ),
# tabPanel(title = "Panel 2",
# fluidRow(actionButton("button2", "Button 2"))
# )
)
server <- shinyServer(function(input, output, session) {
introjs(session)
})
shinyApp(ui, server)
Here's the answer provided here:
library(shiny)
library(rintrojs)
ui <- navbarPage(
title = "foo",
introjsUI(),
tabPanel(
title = introBox("Panel 1",
data.step = 1,
data.intro = "This is Panel 1"),
fluidRow(actionButton("button1", "Button 1"))
),
tabPanel(
title = introBox("Panel 2",
data.step = 2,
data.intro = "This is Panel 2"),
fluidRow(actionButton("button2", "Button 2"))
)
# If you want to see a "normal" app, comment from "introjsUI()" to here, and uncomment the chunk below
# tabPanel(title = "Panel 1",
# fluidRow(actionButton("button1", "Button 1"))
# ),
# tabPanel(title = "Panel 2",
# fluidRow(actionButton("button2", "Button 2"))
# )
)
server <- shinyServer(function(input, output, session) {
introjs(session)
})
shinyApp(ui, server)