css reference when using bsilb package in ShinyApp - css

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

Related

Is it possible to add a sidebarPanel and a mainPanel in each tabPanel using navbarPage?

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)

Active tab to select radio button in Shiny

I have the following Shiny app code where the user can select radio buttons and then the corresponding tab panel is activated.
The question I have is how to do the reverse i.e. if the user selects a tab panel, how do you activate the corresponding radio button.
A reproducible example is below.
If you select Tab 2 radio button for example, Tab 2 is activated
If you then select Tab 3, then Tab 2 radio button remains selected and I would like it to update to Tab 3 radio button
Thanks
library(shiny)
radio_button_choices = list("Tab 1" = 1, "Tab 2" = 2, "Tab 3" = 3)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
radioButtons(inputId = "radio_button", label = h5("Select tab"), choices = radio_button_choices)),
mainPanel(
tabsetPanel(id = "tab",
tabPanel("Tab1", value = "panel1", htmlOutput("text1")),
tabPanel("Tab2", value = "panel2", htmlOutput("text2")),
tabPanel("Tab3", value = "panel3", htmlOutput("text3"))
)
)
)
)
server <- function(input, output, session) {
observeEvent(input$radio_button, {
updateTabsetPanel(session, "tab",
selected = paste0("panel", input$radio_button)
)
})
output$text1 = renderUI({
str1 = "This is tab 1"
HTML(paste(str1))
})
output$text2 = renderUI({
str1 = "This is tab 2"
HTML(paste(str1))
})
output$text3 = renderUI({
str1 = "This is tab 3"
HTML(paste(str1))
})
}
# Run the application
shinyApp(ui = ui, server = server)
You can do something similar with updateRadioButtons.
You also might like a similar vector for your tabPanel choices.
library(shiny)
radio_button_choices = list("Tab 1" = 1, "Tab 2" = 2, "Tab 3" = 3)
panel_choices = list("Panel 1" = 1, "Panel 2" = 2, "Panel 3" = 3)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
radioButtons(inputId = "radio_button", label = h5("Select tab"), choices = radio_button_choices)),
mainPanel(
tabsetPanel(id = "tab",
tabPanel(names(panel_choices)[1], value = panel_choices[[1]], htmlOutput("text1")),
tabPanel(names(panel_choices)[2], value = panel_choices[[2]], htmlOutput("text2")),
tabPanel(names(panel_choices)[3], value = panel_choices[[3]], htmlOutput("text3"))
)
)
)
)
server <- function(input, output, session) {
observeEvent(input$radio_button, {
updateTabsetPanel(session, "tab", selected = input$radio_button)
})
output$text1 = renderUI({
str1 = "This is tab 1"
HTML(paste(str1))
})
output$text2 = renderUI({
str1 = "This is tab 2"
HTML(paste(str1))
})
output$text3 = renderUI({
str1 = "This is tab 3"
HTML(paste(str1))
})
observeEvent(input$tab, {
updateRadioButtons(session, "radio_button", selected = input$tab)
})
}
# Run the application
shinyApp(ui = ui, server = server)

Disable walking between tabs Shiny

I have shiny application with several tabs.
The problem is that I want to walk between tabs with button, not by clicking on the tab. How I can disable clicking on tabs?
Small example of code:
ui <- navbarPage('Test App', id = "inTabset",
tabPanel(title = "Panel 1", value = "panel1",
actionButton('jumpToP2', 'Jump to Secon Tab')),
tabPanel(title = "Panel 2", value = "panel2",
actionButton('jumpToP1', 'Jump to First Tab'))
)
server <- function(input, output, session) {
observeEvent(input$jumpToP2, {
updateTabsetPanel(session, "inTabset",
selected = "panel2")
})
observeEvent(input$jumpToP1, {
updateTabsetPanel(session, "inTabset",
selected = "panel1")
})
}
shinyApp(ui, server)
Here is a possible workaround. We can use shinyjs to disable the navbar buttons, and add some CSS to change the cursor to default when hovering the navigation bar.
There may be simpler ways that I am not aware of, so I am curious to see other possible solution approaches :) Hope this helps!
library(shiny)
library(shinyjs)
ui <- navbarPage('Test App', id = "inTabset",
tabPanel(title = "Panel 1", value = "panel1",
actionButton('jumpToP2', 'Jump to Secon Tab')),
tabPanel(title = "Panel 2", value = "panel2",
actionButton('jumpToP1', 'Jump to First Tab')),
useShinyjs(),
tags$head(tags$style(HTML('.navbar-nav a {cursor: default}')))
)
server <- function(input, output, session) {
shinyjs::disable(selector = '.navbar-nav a')
observeEvent(input$jumpToP2, {
updateTabsetPanel(session, "inTabset",
selected = "panel2")
})
observeEvent(input$jumpToP1, {
updateTabsetPanel(session, "inTabset",
selected = "panel1")
})
}
shinyApp(ui, server)

shiny disable tables in a specific navlistPanel

every one, I want to make a shiny app, which can disable tables in a specific navlistPanel, follow is my code which can disabe all the tabs in navlistPanel:
ui <- fluidPage(
useShinyjs(),
navlistPanel(id = "inTabset1",
tabPanel(title = "Panel 1", value = "panel1",
actionButton('jumpToP2', 'Jump to Second Tab')),
tabPanel(title = "Panel 2", value = "panel2",
actionButton('jumpToP1', 'Jump to First Tab'))
# tags$head(tags$style(HTML('.navbar-nav a {cursor: default}')))),
navlistPanel(id = "inTabset2",
tabPanel(title = "Panel 3", value = "panel3",
actionButton('jumpToP3', 'Jump to fouth Tab')),
tabPanel(title = "Panel 4", value = "panel4",
actionButton('jumpToP4', 'Jump to third Tab'))
# tags$head(tags$style(HTML('.navbar-nav a {cursor: default}')))))
server <- function(input, output, session) {
# shinyjs::disable(selector = '.navbar-nav a'
shinyjs::disable(
# id = "inTabset1",
selector = '.nav li a'
)
observeEvent(input$jumpToP2, {
updateTabsetPanel(session, "inTabset1",
selected = "panel2")
})
observeEvent(input$jumpToP1, {
updateTabsetPanel(session, "inTabset1",
selected = "panel1")
})
observeEvent(input$jumpToP3, {
updateTabsetPanel(session, "inTabset2",
selected = "panel4")
})
observeEvent(input$jumpToP4, {
updateTabsetPanel(session, "inTabset2",
selected = "panel3")
})}
shinyApp(ui, server)
Those code can disable all the tabs in two navlistPanle. However, when I want to only disable the tabs in the first navlistPanel, inTabset1, so I add the id to the function of disable like this:
shinyjs::disable(
id = "inTabset1",
selector = '.nav li a'
)
It did not work any more! All the tabs are not disabled! So any guys can help me for this question? Thanks very much!
You can not use both the arguments id and selector in disable, see the documentation for the function here:
id The id of the input element/Shiny tag
selector Query selector of
the elements to target. Ignored if the id argument is given. For
example, to disable all text inputs, use selector =
"input[type='text']"
What you could do however, is change your selector to '#inTabset1 li a', so it will disable all elements of class a that are in an element class li that are in the element with id inTabset1.
Here is a working example, I hope this helps!
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
navlistPanel(id = "inTabset1",
tabPanel(title = "Panel 1", value = "panel1",
actionButton('jumpToP2', 'Jump to Second Tab')),
tabPanel(title = "Panel 2", value = "panel2",
actionButton('jumpToP1', 'Jump to First Tab'))),
# tags$head(tags$style(HTML('.navbar-nav a {cursor: default}')))),
navlistPanel(id = "inTabset2",
tabPanel(title = "Panel 3", value = "panel3",
actionButton('jumpToP3', 'Jump to fouth Tab')),
tabPanel(title = "Panel 4", value = "panel4",
actionButton('jumpToP4', 'Jump to third Tab'))
# tags$head(tags$style(HTML('.navbar-nav a {cursor: default}')))))
)
)
server <- function(input, output, session) {
# shinyjs::disable(selector = '.navbar-nav a'
shinyjs::disable(
selector = '#inTabset1 li a'
)
observeEvent(input$jumpToP2, {
updateTabsetPanel(session, "inTabset1",
selected = "panel2")
})
observeEvent(input$jumpToP1, {
updateTabsetPanel(session, "inTabset1",
selected = "panel1")
})
observeEvent(input$jumpToP3, {
updateTabsetPanel(session, "inTabset2",
selected = "panel4")
})
observeEvent(input$jumpToP4, {
updateTabsetPanel(session, "inTabset2",
selected = "panel3")
})}
shinyApp(ui, server)

Add Tooltip to Tabs in Shiny

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.

Resources