How to Switch Between NavBar Tabs with a Button R Shiny - r

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)

Related

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)

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)

Pop up a shinyFiles dialog R Shiny without a shinyFiles button

I would like to have one of the tabPanels in my Shiny app launch a shinyFiles style input. In this case I would like to launch a shinySaveButton, without the shinySaveButton being in my dataset (By clicking the save icon [which is actually a tabPanel])
Reproducible example below
library(shiny)
library(shinyFiles)
ui <- navbarPage('Test App',id = "inTabset", selected="panel1",
tabPanel(title = "", value = "Save", icon = icon("save")),
tabPanel(title = "Panel 1", value = "panel1",
h1("Panel1")),
tabPanel(title = "Panel 2",value = "panel2",
h1("Panel2"))
)
server <- function(input, output, session) {
values = reactiveValues(tabSelected="panel1")
observe({
if (input$inTabset=="Save") {
updateNavbarPage(session,"inTabset",selected=values$tabSelected)
#CODE FOR LOADING SHINYFILES DIALOG IN HERE
} else {
values$tabSelected<-input$inTabset
}
})
}
shinyApp(ui, server)
Any help would be greatly appreciated.
Work around using hidden element trick
library(shiny)
library(shinyFiles)
library(shinyjs)
jsCode<-"shinyjs.saveButton=function(){ $('#buttonFileSaveHidden').click(); }"
ui <- fluidPage(
useShinyjs(),
extendShinyjs(text = jsCode),
navbarPage('Test App',id = "inTabset", selected="panel1",
tabPanel(title = "", value = "Save", icon = icon("save")),
tabPanel(title = "Panel 1", value = "panel1",
h1("Panel1")
),
tabPanel(title = "Panel 2",value = "panel2",
h1("Panel2"))
),
# HIDDEN BUTTON TO INITIATE THE SAVE
hidden(shinySaveButton( "buttonFileSaveHidden",
label="",
title="Save as ...",
list('hidden_mime_type'=c("R")),
class='hiddenButton')),
wellPanel( #ONLY INCLUDED TO DISPLAY OF PATH INFO OF THE CHOICE
h3('Current save path info'),
tableOutput('table')
)
)
server <- function(input, output, session) {
values = reactiveValues(tabSelected="panel1")
observe({
if (input$inTabset=="Save") {
updateNavbarPage(session,"inTabset",selected=values$tabSelected)
#CODE FOR LOADING SHINYFILES DIALOG IN HERE
js$saveButton()
} else {
values$tabSelected<-input$inTabset
}
})
shinyFileSave(input, "buttonFileSaveHidden", session=session, roots=c(wd="~"), filetypes=c('R') ) #hidden
# GET THE SAVE PATH CHOICE AND RECORD IT IN fp.dt.rv
fp.dt.rv<-reactiveVal("")
observeEvent(input$buttonFileSaveHidden,{
fp.dt<-parseSavePath(c(wd='~'), input$buttonFileSaveHidden)
fp.dt.rv(fp.dt) #or just use to immediately write.
})
# ONLY TO DISPLAY THE SAVE CHOICE
output$table <- renderTable(fp.dt.rv())
}
shinyApp(ui, server)

scoping issue with updateNavbarPage() function from within shiny module

I am trying to build an app where the user is able to switch tabs when clicking on a specific object. However, I have developed the app using modules and would like to continue to do so. I am running into a problem with the scoping when trying to call the updateNavbarPage() function from inside of the modules. I have created a MWE example to illustrate the problem.
#==================================================
# MRE for updateNavBar scoping issue within modules
#==================================================
modOneUI <- function(id){
ns <- NS(id)
tagList(
h4(
"Click this button to change tabs!"
),
actionButton(
ns("submit"),
label = "Go to next Tab"
)
)
}
modOne <- function(input, output, session){
observeEvent(input$submit, {
updateNavbarPage(session, "nav-page", "tab2")
})
}
ui <- shinyUI(
navbarPage(
id = "nav-page",
title = "Example Navbar Page Issue",
tabPanel(
id = "tab1",
value = "tab1",
div(
"Tab 1"
),
div(
modOneUI("tab1_mod")
)
),
tabPanel(
id = "tab2",
value = "tab2",
div(
"Tab 2"
),
div(
h4("This is the second tab")
)
)
)
)
server <- shinyServer(function(input, output, session){
callModule(modOne, "tab1_mod")
})
shinyApp(ui = ui, server = server)
When this app is run, and the action button is clicked on the first tab, nothing happens. However if you remove the module and place the ui and server module code directly into the ui and server portions then clicking the button works. Here is the code with the modules removed.
ui <- shinyUI(
navbarPage(
id = "nav-page",
title = "Example Navbar Page Issue",
tabPanel(
id = "tab1",
value = "tab1",
div(
"Tab 1"
),
div(
h4(
"Click this button to change tabs!"
),
actionButton(
"submit",
label = "Go to next Tab"
)
)
),
tabPanel(
id = "tab2",
value = "tab2",
div(
"Tab 2"
),
div(
h4("This is the second tab")
)
)
)
)
server <- shinyServer(function(input, output, session){
observeEvent(input$submit, {
updateNavbarPage(session, "nav-page", "tab2")
})
})
shinyApp(ui = ui, server = server)
Is there any way to use updateNavbarPage() from within a module to switch to a tab that is in not in the module?
Do not ask me why :-) but it works like this:
modOne <- function(input, output, session, x){
observeEvent(input$submit, {
updateNavbarPage(x, "nav-page", "tab2")
})
}
callModule(modOne, "tab1_mod", x=session)

Use dynamic radioButtons in Shiny

In a Shiny app I create radioButtons dynamically on the server and use renderUI to pass this to the client. Now I have a problem of getting the response of the radioButtons (selected item) back for further processing. Below the stripped down version of my problem.
library(shiny)
ui <- shinyUI(pageWithSidebar(
headerPanel("test dynamic radio buttons"),
sidebarPanel(
),
mainPanel(
x <- uiOutput('radioTest'),
actionButton('submit', label = "Submit"),
br(),
print(paste("Radiobutton response is:", "reply()")),
textOutput('text')
)
))
server <- shinyServer(
function(input, output) {
output$radioTest <- renderUI({
options <- c("item 1", "item 2", "item 3")
# The options are dynamically generated on the server
radioButtons('reply', 'What item do you select ?', options, selected = character(0))
})
observe({
input$submit
isolate(
output$text <- renderText({
paste("Radiobutton response is:", "reply()" )
})
)
})
}
)
# Run the application
shinyApp(ui = ui, server = server)
Do you want something like the following?
library(shiny)
ui <- shinyUI(pageWithSidebar(
headerPanel("test dynamic radio buttons"),
sidebarPanel(
),
mainPanel(
x <- uiOutput('radioTest'),
actionButton('submit', label = "Submit"),
br(),
#print(paste("Radiobutton response is:", "reply")),
textOutput('text')
)
))
server <- shinyServer(
function(input, output) {
output$radioTest <- renderUI({
options <- c("item 1", "item 2", "item 3")
# The options are dynamically generated on the server
radioButtons('reply', 'What item do you select ?', options, selected = character(0))
})
observe({
input$submit
isolate(
output$text <- renderText({
paste("Radiobutton response is:", input$reply )
})
)
})
}
)
# Run the application
shinyApp(ui = ui, server = server)

Resources