shiny disable tables in a specific navlistPanel - r

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)

Related

css reference when using bsilb package in ShinyApp

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

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)

R shiny dashboard body dependant from shiny subitem selection

Is it a way to create an shiny observeEvent dependant from shiny subitem selection?
In the following reproductible example, I would like to automaticaly execute button 1 when submenu 1 is clicked and automaticaly execute button 3 when submenu 2 is clicked.
library(shinydashboard)
library(shiny)
ui <- dashboardPage(
dashboardHeader(title = "Dynamic sidebar"),
dashboardSidebar(
sidebarMenuOutput("menu")
),
dashboardBody(heigth = 800, tabItems(
tabItem(tabName = "submenu_1",
fluidRow(
actionButton(inputId = "button_1",label = "Button 1", icon = icon("fa"),width = '417px'),
actionButton(inputId = "button_2",label = "Button 2", icon = icon("fa"),width = '417px')
)
),
tabItem(tabName = "submenu_2",
fluidRow(
actionButton(inputId = "button_3",label = "Button 3", icon = icon("fa"),width = '417px'),
actionButton(inputId = "button_4",label = "Button 4", icon = icon("fa"),width = '417px')
)
)
),
textOutput("text")
)
)
server <- function(input, output) {
output$menu <- renderMenu({
sidebarMenu(
menuItem("Menu item 1",
menuSubItem('Submenu 1',tabName = 'submenu_1',icon = icon('line-chart')),
menuSubItem('Submenu 2',tabName = 'submenu_2',icon = icon('line-chart'))
)
)
})
observeEvent(input$button_1,{output$text <- renderText("Buutton 1 must be selected by default on Submenu 1")})
observeEvent(input$button_2,{output$text <- renderText("You have selected button 2")})
observeEvent(input$button_3,{output$text <- renderText("Buutton 3 must be selected by default on Submenu 2 ")})
observeEvent(input$button_4,{output$text <- renderText("You have selected button 4")})
}
shinyApp(ui, server)
Thanks in advance!
Is that what you need??
You can add an id argument in sidebarMenu, and then add an observeEvent object triggered by input$sidebarmenu
library(shinydashboard)
library(shiny)
ui <- dashboardPage(
dashboardHeader(title = "Dynamic sidebar"),
dashboardSidebar(
sidebarMenuOutput("menu")
),
dashboardBody(heigth = 800, tabItems(
tabItem(tabName = "submenu_1",
fluidRow(
actionButton(inputId = "button_1",label = "Button 1", icon = icon("fa"),width = '417px'),
actionButton(inputId = "button_2",label = "Button 2", icon = icon("fa"),width = '417px')
)
),
tabItem(tabName = "submenu_2",
fluidRow(
actionButton(inputId = "button_3",label = "Button 3", icon = icon("fa"),width = '417px'),
actionButton(inputId = "button_4",label = "Button 4", icon = icon("fa"),width = '417px')
)
)
),
textOutput("text")
)
)
server <- function(input, output) {
output$menu <- renderMenu({
sidebarMenu(id = "sidebarmenu",
menuItem("Menu item 1",
menuSubItem('Submenu 1',tabName = 'submenu_1',icon = icon('line-chart')),
menuSubItem('Submenu 2',tabName = 'submenu_2',icon = icon('line-chart'))
)
)
})
observeEvent(input$sidebarmenu,{
output$text <- renderText({
if(input$sidebarmenu=="submenu_1"){
"Buutton 1 must be selected by default on Submenu 1"
}else if(input$sidebarmenu=="submenu_2"){
"Buutton 3 must be selected by default on Submenu 2 "
}
})
})
observeEvent(input$button_1,{
output$text <- renderText("Buutton 1 must be selected by default on Submenu 1")
})
observeEvent(input$button_2,{
output$text <- renderText("You have selected button 2")
})
observeEvent(input$button_3,{
output$text <- renderText("Buutton 3 must be selected by default on Submenu 2 ")
})
observeEvent(input$button_4,{
output$text <- renderText("You have selected button 4")
})
}
shinyApp(ui, server)
The trick is to set the parameter id on the UI part.
The code below does the job :
library(shinydashboard)
library(shiny)
ui <- dashboardPage(
dashboardHeader(title = "Dynamic sidebar"),
dashboardSidebar(
sidebarMenu(id="tabs",
sidebarMenuOutput("menu")
)
),
dashboardBody(heigth = 800, tabItems(
tabItem(tabName = "submenu_1",
fluidRow(
actionButton(inputId = "button_1",label = "Button 1", icon = icon("fa"),width = '417px'),
actionButton(inputId = "button_2",label = "Button 2", icon = icon("fa"),width = '417px')
)
),
tabItem(tabName = "submenu_2",
fluidRow(
actionButton(inputId = "button_3",label = "Button 3", icon = icon("fa"),width = '417px'),
actionButton(inputId = "button_4",label = "Button 4", icon = icon("fa"),width = '417px')
)
)
),
textOutput("text")
)
)
server <- function(input, output) {
output$menu <- renderMenu({
sidebarMenu(
menuItem("Menu item 1",
menuSubItem('Submenu 1',tabName = 'submenu_1',icon = icon('line-chart')),
menuSubItem('Submenu 2',tabName = 'submenu_2',icon = icon('line-chart'))
)
)
})
observeEvent(input$tabs, {
req(input$tabs)
if (input$tabs == "submenu_1") {
# Do whatever you want when submenu_1 is selected
print("submenu_1 selected")
} else if (input$tabs == "submenu_2") {
# Do whatever you want when submenu_2 is selected
print("submenu_2 selected")
}
})
observeEvent(input$button_1,{output$text <- renderText("Buutton 1 must be selected by default on Submenu 1")})
observeEvent(input$button_2,{output$text <- renderText("You have selected button 2")})
observeEvent(input$button_3,{output$text <- renderText("Buutton 3 must be selected by default on Submenu 2 ")})
observeEvent(input$button_4,{output$text <- renderText("You have selected button 4")})
}
shinyApp(ui, 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)

How to Switch Between NavBar Tabs with a Button R Shiny

I need the user to click a button and be taken to a different tabPanel of a navbarPage. Here is a simple app where this could be implemented. How can I achieve this?
ui <- shinyUI(
navbarPage('Test App',
tabPanel('Page 1',
p('This is the first tab'), br(),
actionButton('jumpToP2', 'Jump to Second Tab')
),
tabPanel('Page 2',
p('This is the second tab'),
actionButton('jumpToP1', 'Jump to First Tab')
)
)
)
server <- shinyServer(function(input, output){
observeEvent(input$jumpToP2,{
## Switch active tab to 'Page 2'
})
observeEvent(input$jumpToP1,{
## Switch active tab to 'Page 1'
})
})
shinyApp(ui, server)
You can use updateTabsetPanel to switch between different tabPanels. See the documentation and example codes at https://shiny.rstudio.com/reference/shiny/latest/updateTabsetPanel.html. The code below should fulfill your requirements.
ui <- navbarPage('Test App',id = "inTabset",
tabPanel(title = "Panel 1", value = "panel1",
actionButton('jumpToP2', 'Jump to Second 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)
I'm not so sure that this really the best way for you to design your U... Do you know that tabPanel() will act pretty much the same way as an actionButton() will in this case?
ui <- navbarPage('Test App',id = "inTabset",
tabPanel(title = "Panel 1", uiOutput("panel1")),
tabPanel(title = "Panel 2", uiOutput("panel2"))
)
server <- function(input, output, session) {
output$panel1 <- renderUI({
#your UI data
})
output$panel2 <- renderUI({
#your UI data
})
}
shinyApp(ui, server)

Resources