Active tab to select radio button in Shiny - r

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)

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

Move from one tab to another using actionButton when then name of the tab is dynamic

How can I move from one tab to another using actionButton() when then name of the tab is dynamic in a shiny app?
library(shiny)
ui <- fluidPage(
tabsetPanel(
id="inTabset",
tabPanel("Tab 1",textInput("name","Name"),actionButton("switch_tab", "Go to the third tab")
),
tabPanel("Tab 2", "there!"),
tabPanel(textOutput("TAB3")))
)
server <- function(input, output, session) {
observeEvent(input$switch_tab, {
updateTabsetPanel(session, "inTabset",selected = "Tab 3")
})
output$TAB3<-renderText({
if(input$name==""){
"Tab 3"
}
else{
paste(input$name)
}
})
}
shinyApp(ui = ui, server = server)
Just use tabPanel's value parameter:
From ?tabPanel:
value - The value that should be sent when tabsetPanel reports that this tab is selected. If omitted and tabsetPanel has an id, then
the title will be used.
library(shiny)
ui <- fluidPage(tabsetPanel(
id = "inTabset",
tabPanel(
"Tab 1",
textInput("name", "Name"),
actionButton("switch_tab", "Go to the third tab")
),
tabPanel("Tab 2", "there!"),
tabPanel(textOutput("TAB3"), value = "TAB3")
))
server <- function(input, output, session) {
observeEvent(input$switch_tab, {
updateTabsetPanel(session, "inTabset", selected = "TAB3")
})
output$TAB3 <- renderText({
if (input$name == "") {
"Tab 3"
} else{
paste(input$name)
}
})
}
shinyApp(ui = ui, server = server)

How to clear the mainPanel if a selectInput choice has changed?

I am trying to create an app that will show you results depending on a selectInput and the changes are controlled by actionButtons.
When you launch the app, you have to select a choice: Data 1 or Data 2. Once you have selected your choice (e.g. Data 1), you have to click the actionButton "submit type of data". Next, you go to the second tab, choose a column and then click "submit".
The output will be: one table, one text and one plot.
Then, if you go back to the first tab and select "Data 2", everything that you have generated is still there (as it is expected, since you didn't click any button).
However, I would like to remove everything that is in the mainPanel if I change my first selectInput as you could see it when you launch the app for the first time.
The idea is that since you have changed your first choice, you will have to do the same steps again (click everything again).
I would like to preserve and control the updates with actionButtons as I have in my code (since I am working with really long datasets and I don't want to depend on the speed of loading things that I don't want until I click the button). Nevertheless, I cannot think a way to remove everything from mainPanel if I change the choice of the first selectInput.
Does anybody have an idea how I can achieve this?
Thanks in advance
Code:
library(shiny)
library(shinyWidgets)
library(shinyFeedback)
library(DT)
library(datasets)
ui <- fluidPage(
sidebarPanel(
tabsetPanel(id="histogram",
tabPanel("Selection",
useShinyFeedback(),
selectInput(inputId = "type", label = "Select your data",
choices = c("Data 1" = "data1",
"Data 2" = "data2")),
conditionalPanel(
condition = "input.type == 'data2'",
div(style = "position:absolute;right:2.5em;",
actionButton(
inputId = "button_more_info_data2",
label = "More info",
icon = icon("info-circle"))
)
),
actionButton(
inputId = "button",
label = "Submit type of data",
icon = icon("check")
)
),
tabPanel("Pick the column",
br(),
selectizeInput(inputId = "list_columns", label = "Choose the column:", choices=character(0)),
actionButton(
inputId = "button2",
label = "Submit")
))
),
mainPanel(
dataTableOutput("table"),
textOutput("text"),
plotOutput("myplot")
)
)
server <- function(input, output, session) {
observeEvent(input$type,{
feedbackWarning(inputId = "type",
show = ("data2" %in% input$type),
text ="This data is... Please, be careful..."
)
})
mydata <- reactive({
if(input$type == "data1"){
mtcars
}else{
iris
}
}) %>% bindEvent(input$button2)
# This is to generate the choices (gene list) depending on the user's input.
observeEvent(input$button, {
updateSelectizeInput(
session = session,
inputId = "list_columns",
choices = colnames(trees), options=list(maxOptions = length(colnames(trees))),
server = TRUE
)
})
output$table <- renderDataTable({
req(input$button2)
mydata()
})
output$text <- renderText({
req(input$button2)
input$list_columns
})
output$myplot <- renderPlot({
req(input$button2, input$button)
hist(trees[,input$list_columns])
})
}
if (interactive())
shinyApp(ui, server)
Here is an example using a reset button - using the selectInput you'll end up with a circular reference:
library(shiny)
library(shinyWidgets)
library(shinyFeedback)
library(DT)
library(datasets)
ui <- fluidPage(sidebarPanel(tabsetPanel(
id = "histogram",
tabPanel(
"Selection",
useShinyFeedback(),
selectInput(
inputId = "type",
label = "Select your data",
choices = c("Data 1" = "data1",
"Data 2" = "data2")
),
conditionalPanel(
condition = "input.type == 'data2'",
div(
style = "position:absolute;right:2.5em;",
actionButton(
inputId = "button_more_info_data2",
label = "More info",
icon = icon("info-circle")
)
)
),
actionButton(
inputId = "button",
label = "Submit type of data",
icon = icon("check")
),
actionButton(
inputId = "reset",
label = "Reset",
icon = icon("xmark")
)
),
tabPanel(
"Pick the column",
br(),
selectizeInput(
inputId = "list_columns",
label = "Choose the column:",
choices = character(0)
),
actionButton(inputId = "button2",
label = "Submit")
)
)),
mainPanel(
dataTableOutput("table"),
textOutput("text"),
plotOutput("myplot")
))
server <- function(input, output, session) {
observeEvent(input$type, {
feedbackWarning(
inputId = "type",
show = ("data2" %in% input$type),
text = "This data is... Please, be careful..."
)
})
mydata <- reactiveVal(NULL)
observe({
if (input$type == "data1") {
mydata(mtcars)
} else if (input$type == "data2") {
mydata(iris)
} else {
mydata(data.frame())
}
}) %>% bindEvent(input$button2)
observeEvent(input$reset, {
mydata(data.frame())
})
# This is to generate the choices (gene list) depending on the user's input.
observeEvent(input$button, {
updateSelectizeInput(
session = session,
inputId = "list_columns",
choices = colnames(trees),
options = list(maxOptions = length(colnames(trees))),
server = TRUE
)
})
output$table <- renderDataTable({
req(input$button2)
mydata()
})
output$text <- renderText({
req(input$button2)
input$list_columns
})
output$myplot <- renderPlot({
req(input$button2, input$button)
hist(trees[, input$list_columns])
})
}
shinyApp(ui, server)

Hide one of the checkbox group choices but stiil keep its functionallity activated

I have a basic shiny app below with a checkbox group and the printed results of it. I was wondering if it is possible to somehow hide one of the 3 choices (for example "1") but the printed result should still include "1".
#ui.r
fluidPage(
# Copy the chunk below to make a group of checkboxes
checkboxGroupInput("checkGroup", label = h3("Checkbox group"),
choices = list("Choice 1" = 1, "Choice 2" = 2, "Choice 3" = 3),
selected = 1),
hr(),
fluidRow(column(3, verbatimTextOutput("value")))
)
#server.r
function(input, output) {
# You can access the values of the widget (as a vector)
# with input$checkGroup, e.g.
output$value <- renderPrint({ input$checkGroup })
}
With CSS:
ui <- fluidPage(
tags$head(
tags$style(HTML("input[name=checkGroup][value='1'] { display: none }"))
),
checkboxGroupInput("checkGroup", label = h3("Checkbox group"),
choices = list("Choice 1" = 1, "Choice 2" = 2, "Choice 3" = 3),
selected = 1),
hr(),
fluidRow(column(3, verbatimTextOutput("value")))
)
It isn't a checkboxGroupInput, but it mimics the idea...
library(shiny)
ui <- fluidPage(
# Copy the chunk below to make a group of checkboxes
checkboxGroupInput("checkGroup", label = h3("Checkbox group"),
choices = list("Choice 1" = 1, "Choice 2" = 2, "Choice 3" = 3),
selected = 1),
hr(),
conditionalPanel(
"input.check1 == 'T'",
checkboxInput("check1", "Choice 1", value = T)
),
checkboxInput("check2", "Choice 2", value = F),
checkboxInput("check3", "Choice 3", value = F),
hr(),
fluidRow(column(3, verbatimTextOutput("value"))),
fluidRow(column(3, verbatimTextOutput("value2")))
)
server <- function(input, output) {
# You can access the values of the widget (as a vector)
# with input$checkGroup, e.g.
output$value <- renderPrint({ input$checkGroup })
output$value2 <- renderPrint({ c(input$check1, input$check2, input$check3)})
}
shinyApp(ui, 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)

Resources