Having issues calling updateTabsetPanel within a Shiny module, works fine without.
library(shiny)
mod_ui <- function(id){
ns <- NS(id)
tagList(
actionButton(ns("back"), "back")
)
}
mod <- function(input, output, session){
observeEvent(input$back, {
print("Button click, go back to home tab")
updateTabsetPanel(session = session, inputId = "tabs", selected = "home")
})
}
ui <- navbarPage(
"example",
id = "tabs",
tabPanel(
"home",
h4("updateTabsetPanel does not work with modules"),
h5("But the button below does"),
actionButton("switch", "switch")
),
tabPanel(
"secondtab",
mod_ui("second")
)
)
server <- function(input, output, session){
callModule(mod, "second")
observeEvent(input$switch, {
updateTabsetPanel(session = session, inputId = "tabs", selected = "secondtab")
})
}
shinyApp(ui, server)
Modules are designed in such a way that each module is absolutely self contained. If you need to communicate with the parent which called the module, parameters need to be passed explicitly. Here is how it is done:
library(shiny)
mod_ui <- function(id){
ns <- NS(id)
tagList(
actionButton(ns("back"), "back")
)
}
mod <- function(input, output, session,parent_session){
observeEvent(input$back, {
print("Button click, go back to home tab")
updateTabsetPanel(session = parent_session, inputId = "tabs", selected = "home")
})
}
ui <- navbarPage(
"example",
id = "tabs",
tabPanel(
"home",
h4("updateTabsetPanel does not work with modules"),
h5("But the button below does"),
actionButton("switch", "switch")
),
tabPanel(
"secondtab",
mod_ui("second")
)
)
server <- function(input, output, session){
callModule(mod, "second",parent_session = session)
observeEvent(input$switch, {
updateTabsetPanel(session = session, inputId = "tabs", selected = "secondtab")
})
}
shinyApp(ui, server)
The parent session is explicitly passed to the module.
Related
Background
I am using {brochure} and {golem} to build a shiny app. I have one outer module grid that consists of inner modules subGrid2 which displays the same module UI on two tabs.
GOAL
have a module subGrid2 that can be used for repeating graph
visualizations on multiple tabs.
in the REPREX --> fake graph generated from {shinipsum} to
be displayed on the "Home" tab + "Portfolio" tab
use observeEvent to look at the slected tab and generate server response respectivley
Problem
The observeEvent reactive expr. fails to recognize when the corresponding tab is selected to generate the correct server response.
-using the reprex below replicates my issue-
TL/DR
Why wont the observeEvent reactive generate the correct server response per the selected tab?
REPREX
uncomment observeEvent to see error
#22.2.22
library(brochure)
library(shiny)
library(shinipsum)
library(shinydashboard)
library(shinydashboardPlus)
mod_subGrid2_ui <- function(id) {
ns <- NS(id)
tagList(
plotOutput(ns("plot"))
)
}
mod_subGrid2_server <- function(id) {
moduleServer(id, function(input, output, session) {
ns <- session$ns
output$plot <- renderPlot({
shinipsum::random_ggplot()
})
})
}
#Setup dashboard
mod_Grid_ui <- function(id) {
ns <- NS(id)
shinydashboardPlus::dashboardPage(
skin = "midnight",
header = dashboardHeader(title = "test"),
sidebar = dashboardSidebar(
shinydashboard::sidebarMenu(
# Setting id makes input$tabs give the tabName of currently-selected tab
id = "tabs",
menuItem("Home", tabName = "home", icon = icon("tachometer-alt")),
menuItem("Portfolio", tabName = "portfolio", icon = icon("chart-line"), badgeLabel = "new",
badgeColor = "green")
)
),
body = shinydashboard::dashboardBody(
# Enable shinyjs
shinyjs::useShinyjs(),
shinydashboard::tabItems(
shinydashboard::tabItem("home",
shiny::tagList(
div(p("Content for 1st tab goes here -- GRID MODULE")),
mod_subGrid2_ui(ns("subGrid2_ui_1"))
)
),
shinydashboard::tabItem("portfolio",
shiny::tagList(
div(p("Content for 2nd goes here -- GRID MODULE (2x)")),
titlePanel(title = "The same module UI goes here"),
mod_subGrid2_ui(ns("subGrid2_ui_2"))
)
)
)
)
)
}
mod_Grid_server <- function(id) {
moduleServer(id, function(input, output, session) {
ns <- session$ns
mod_subGrid2_server("subGrid2_ui_1")
mod_subGrid2_server("subGrid2_ui_2")
## uncomment to try
# observeEvent(input$tabs,{
# if(input$tabs == "home"){
# # <subGrid> server fragment
# mod_subGrid2_server("subGrid2_ui_1")
# } else if(input$tabs == "portfolio"){
# mod_subGrid2_server("subGrid2_ui_1")
# }
# }, ignoreNULL = TRUE, ignoreInit = TRUE)
})
}
brochureApp(
page(
href = "/",
ui = tagList(
mod_Grid_ui("grid_1")
),
server = function(input, output, session) {
mod_Grid_server("grid_1")
}
),
wrapped = shiny::tagList
)
When using a module nested inside another module, you need to ns() the id of the nested UI function.
So here, mod_subGrid2_ui(ns("subGrid2_ui_1")).
Here is a minimal reprex:
mod_subGrid2_ui <- function(id) {
ns <- NS(id)
tagList(
plotOutput(ns("plot"))
)
}
mod_subGrid2_server <- function(id) {
moduleServer(id, function(input, output, session) {
ns <- session$ns
output$plot <- renderPlot({
shinipsum::random_ggplot()
})
})
}
mod_Grid_ui <- function(id) {
ns <- NS(id)
tagList(
mod_subGrid2_ui(ns("subGrid2_ui_1"))
)
}
mod_Grid_server <- function(id) {
moduleServer(id, function(input, output, session) {
ns <- session$ns
mod_subGrid2_server("subGrid2_ui_1")
})
}
brochureApp(
page(
href = "/",
ui = tagList(
mod_Grid_ui("grid_1")
),
server = function(input, output, session) {
mod_Grid_server("grid_1")
}
)
)
I am trying to use modules while developing a shinyApp and I am failing to add a sidebarPanel that change when I change a tabPanel in the mainPanel. For example, when the user is on "Tab1" a h4() element should be added to the sidebarPanel with "Title" and when the user is on "Tab2" the sidebarPanel should show a selectInput(). This is the code I am using. Any idea on what I am doing wrong?
library(shiny)
# Module UI ####
modUI = function(id) {
ns = NS(id)
tabPanel("Dummy Panel",
sidebarPanel("SibeBarPanel",
conditionalPanel("input.ns(mainpanel) == 1",
h4("Title")),
conditionalPanel("input.ns(mainpanel) == 2",
selectInput(ns("s_1"), "Label1", choices = c("A","B")))
),
mainPanel(
tabsetPanel(id=ns("mainpanel"),
tabPanel("Tab1", value = 1),
tabPanel("Tab2", value = 2))))
}
# Module Server ####
modServer <- function(id) {
moduleServer(id, function(input, output, session) {
})
}
server = function(input, output, session) {
modServer("v1")
}
ui = shinyUI(
navbarPage("Dummy",
navbarMenu("This",
modUI("v1")))
)
server = function(input, output, session) {
modServer("v1")
}
shinyApp(ui, server)
By now conditionalPanel has a ns argument:
The namespace() object of the current module, if any.
Please check the following:
library(shiny)
# Module UI ####
modUI = function(id) {
ns = NS(id)
tabPanel("Dummy Panel",
sidebarPanel("SibeBarPanel",
conditionalPanel("input.mainpanel == 1",
h4("Title"), ns = ns),
conditionalPanel("input.mainpanel == 2",
selectInput(ns("s_1"), "Label1", choices = c("A","B")), ns = ns)
),
mainPanel(
tabsetPanel(id=ns("mainpanel"),
tabPanel("Tab1", value = 1),
tabPanel("Tab2", value = 2))))
}
# Module Server ####
modServer <- function(id) {
moduleServer(id, function(input, output, session) {
})
}
server = function(input, output, session) {
modServer("v1")
}
ui = shinyUI(
navbarPage("Dummy",
navbarMenu("This",
modUI("v1")))
)
server = function(input, output, session) {
modServer("v1")
}
shinyApp(ui, server)
Result:
<div data-display-if="input.mainpanel == 1" data-ns-prefix="v1-">
<h4>Title</h4>
</div>
I have a shiny app with multiple tabs, and I would like to have action buttons within the tabs that allow the user to switch tabs. I previously asked this question: R Shiny: Change tabs from within a module
and got an answer that helped, but didn't completely solve my problem.
When I use the same id (tab.1) to call modtab1 and modtab2, it allows me to switch tabs, but it doesn't distinguish between the two input$userids; when I use different id's it distinguishes between the two input$userids but doesn't allow me to switch tabs.
library(shiny)
modtab1_ui <- function(id) {
ns <- NS(id)
tabPanel(title = 'Tab 1',
value = NS(id, 'tab.1'),
h4('This is the first tab'),
actionButton(NS(id, 'nexttab'), 'Next Tab'),
textInput(NS(id, 'userid'), 'User ID'),
textOutput(outputId = NS(id, 'id'))
) # tabPanel
}
modtab1_server <- function(id) {
moduleServer(id,
function(input, output, session) {
observeEvent(input$nexttab, {
print(paste('switching to tab 2', input$userid))
updateTabsetPanel(session = session, inputId = 'tabs',
# selected = NS('tab2', 'tab.2')
# selected = 'tab.2'
selected = ns('tab.2')
)
})
output$id <- renderText(input$userid)
})
}
modtab2_ui <- function(id) {
ns <- NS(id)
tabPanel(title = 'Tab 2',
value = NS(id, 'tab.2'),
h4('This is the second tab'),
actionButton(NS(id, 'firsttab'), 'First Tab'),
textInput(NS(id, 'userid'), 'User ID'),
textOutput(outputId = NS(id, 'useridout'))
) # tabPanel
}
modtab2_server <- function(id) {
moduleServer(id,
function(input, output, session) {
observeEvent(input$firsttab, {
print(paste('switching to tab 1', input$userid))
updateTabsetPanel(session = session, inputId = 'tabs',
# selected = NS('tab1', 'tab.1')
# selected = 'tab.1'
selected = ns('tab.1')
)
})
output$id <- renderText(input$userid)
})
}
ui <- fluidPage(
tabsetPanel(
'tabs',
modtab1_ui('tab1'),
modtab2_ui('tab2')
)
)
server <- function(input, output, session) {
modtab1_server('tab1')
modtab2_server('tab2')
}
shinyApp(ui = ui, server = server)
Here's a MWE that, I think, gives you what you want.
library(shiny)
modtab1_ui <- function(id) {
ns <- NS(id)
tabPanel(
title = 'Tab 1',
value = ns('tab'),
h4('This is the first tab'),
actionButton(ns('nexttab'), 'Next Tab')
) # tabPanel
}
modtab1_server <- function(id) {
moduleServer(id,
function(input, output, session) {
retVal <- reactiveValues(count=0)
observeEvent(input$nexttab, retVal$count <- retVal$count + 1)
return(reactive(retVal$count))
})
}
modtab2_ui <- function(id) {
ns <- NS(id)
tabPanel(
title = 'Tab 2',
value = ns('tab'),
h4('This is the second tab'),
actionButton(ns('firsttab'), 'First Tab')
) # tabPanel
}
modtab2_server <- function(id) {
moduleServer(id,
function(input, output, session) {
retVal <- reactiveValues(count=0)
observeEvent(input$firsttab, retVal$count <- retVal$count + 1)
return(reactive(retVal$count))
})
}
ui <- fluidPage(
tabsetPanel(
id='tabs',
modtab1_ui('tab1'),
modtab2_ui('tab2')
)
)
server <- function(input, output, session) {
tab1val <- modtab1_server('tab1')
tab2val <- modtab2_server('tab2')
observeEvent(tab1val(), {
updateTabsetPanel(session, 'tabs', selected = 'tab2-tab')
})
observeEvent(tab2val(), {
updateTabsetPanel(session, 'tabs', selected = 'tab1-tab')
})
}
shinyApp(ui = ui, server = server)
Note the changes to your syntax, particularly regarding the use of ns and NS and the arguments passed to the functions.
Also, note the use of return values from the module server functions, and how they are accessed within the main server function.
Building off of Limey's response. You can streamline to one module by additional formals to the UI module.
library(shiny)
modTabUi <- function(id, panelTitle = 'Tab 1', headding = 'This is the first tab', buttonLabel = 'Next Tab') {
ns <- NS(id)
tabPanel(
title = panelTitle,
value = ns('tab'),
h4(headding),
actionButton(ns('nexttab'), buttonLabel)
)
}
modTabServer <- function(id) {
moduleServer(id,
function(input, output, session) {
retVal <- reactiveValues(count = 0)
observeEvent(input$nexttab, retVal$count <- retVal$count + 1)
return(reactive(retVal$count))
})
}
ui <- fluidPage(
tabsetPanel(
id='tabs',
modTabUi('tab1', panelTitle = 'Tab 1', headding = 'This is the first tab', buttonLabel = 'Next Tab'),
modTabUi('tab2', panelTitle = 'Tab 2', headding = 'This is the second tab', buttonLabel = 'Back to First Tab')
)
)
server <- function(input, output, session) {
tab1val <- modTabServer('tab1')
tab2val <- modTabServer('tab2')
observeEvent(tab1val(), {
updateTabsetPanel(session, 'tabs', selected = 'tab2-tab')
})
observeEvent(tab2val(), {
updateTabsetPanel(session, 'tabs', selected = 'tab1-tab')
})
}
shinyApp(ui = ui, server = server)
I have a shiny app with multiple tabs, and I would like to have action buttons within the tabs that allow the user to switch tabs. I found the following pages: https://www.titanwolf.org/Network/q/e6b187b8-6cad-4ece-ad16-7ec73ed2f758/y
How to switch between shiny tab panels from inside a module?, which seem to indicate that the problem is a scoping/namespace error, but they don't fully explain what is happening, and I don't have enough reputation points to comment on the other stackoverflow post asking for clarification.
Here is my sample code:
modtab1_ui <- function(id) {
ns <- NS(id)
tabPanel(title = 'Tab 1',
value = NS(id, 'tab.1'),
h4('This is the first tab'),
actionButton(NS(id, 'nexttab'), 'Next Tab')
)
}
modtab1_server <- function(id) {
moduleServer(id,
function(input, output, session) {
observeEvent(input$nexttab, {
updateTabsetPanel(session = session, inputId = NS(id, 'tabs'), selected = NS(id, 'tab.2'))
print('button clicked')
})
})
}
modtab2_ui <- function(id) {
ns <- NS(id)
tabPanel(title = 'Tab 2',
value = NS(id, 'tab.2'),
h4('This is the second tab'),
)
}
ui <- fluidPage(
tabsetPanel(
id = 'tabs',
modtab1_ui('tab1'),
modtab2_ui('tab1')
)
)
server <- function(input, output, session) {
modtab1_server('tab1')
}
shinyApp(ui = ui, server = server)
EDIT TO ACCOUNT FOR NEW QUESTION
modtab1_ui <- function(id) {
ns <- NS(id)
tabPanel(title = 'Tab 1',
value = NS(id, 'tab.1'),
h4('This is the first tab'),
actionButton(NS(id, 'nexttab'), 'Next Tab'),
textInput(NS(id,'userid'), 'User ID'),
textOutput(NS(id, 'useridout'))
)
}
modtab1_server <- function(id) {
moduleServer(id,
function(input, output, session) {
observeEvent(input$nexttab, {
updateTabsetPanel(session = session, inputId = 'tabs', selected = NS('tab2', 'tab.2'))
print('button clicked'),
})
output$useridout <- renderText(input$userid)
})
}
modtab2_ui <- function(id) {
ns <- NS(id)
tabPanel(title = 'Tab 2',
value = NS(id, 'tab.2'),
h4('This is the second tab'),
actionButton(NS(id, 'firsttab'), 'First Tab'),
textInput(NS(id, 'userid'), 'User ID'),
textOutput(NS(id, 'useridout'))
)
}
modtab2_server <- function(id) {
moduleServer(id,
function(input, output, session) {
observeEvent(input$firsttab, {
updateTabsetPanel(session = session, inputId = 'tabs', selected = NS('tab1', 'tab.1'))
print('button clicked'),
})
output$useridout <- renderText(input$userid)
})
}
ui <- fluidPage(
tabsetPanel(
id = 'tab1-tabs',
modtab1_ui('tab1'),
modtab2_ui('tab2')
)
)
server <- function(input, output, session) {
modtab1_server('tab1')
modtab2_server('tab2')
}
shinyApp(ui = ui, server = server)
EDIT AGAIN
I asked this in a new question, and it was answered: Shiny modules: switch tabs from within modules that have different namespaces
I think this is what you are looking for. Two quite small changes made! One, in the modtab1_server function, I changed the ns(id, 'tabs') to just 'tabs'. I think that since the inputId is within a module, it already adds the id, which in this case means it adds tab1. With your existing code, it would say the tabsetPanel's id is "tab1-tab1-tabs" I think, thus by removing the ns(id) it should make call the inputId as "tab1-tabs". The second change is making the tabsetPanel id to be "tab1-tabs" to encapsulate the way the module adds the "tab1" to the inputId of the updateTabsetPanel.
modtab1_ui <- function(id) {
ns <- NS(id)
tabPanel(title = 'Tab 1',
value = NS(id, 'tab.1'),
h4('This is the first tab'),
actionButton(NS(id, 'nexttab'), 'Next Tab')
)
}
modtab1_server <- function(id) {
moduleServer(id,
function(input, output, session) {
observeEvent(input$nexttab, {
updateTabsetPanel(session = session, inputId = 'tabs', selected = NS(id, 'tab.2'))
print('button clicked')
})
})
}
modtab2_ui <- function(id) {
ns <- NS(id)
tabPanel(title = 'Tab 2',
value = NS(id, 'tab.2'),
h4('This is the second tab'),
)
}
ui <- fluidPage(
tabsetPanel(
id = 'tab1-tabs',
modtab1_ui('tab1'),
modtab2_ui('tab1')
)
)
server <- function(input, output, session) {
modtab1_server('tab1')
}
shinyApp(ui = ui, server = server)
In this code
if (interactive()) {
# Define UI
ui <- fluidPage(
actionButton("add", "Add UI"),
actionButton("remove", "Remove UI"),
tags$div(id = "add")
)
# Server logic
server <- function(input, output, session) {
# adding UI
observeEvent(input$add, {
insertUI(
selector = "#add",
where = "afterEnd",
ui =
div(
textInput("txt", "Insert some text"),
id="textinput"
)
)
})
# removing UI
observeEvent(input$remove, {
removeUI(selector = "#textinput")
})
}
shinyApp(ui, server)
}
I want dynamic UI to appear only once. Regardless of the number of button "add" presses.
However, after you click "Remove UI" button, you should be able to add the dynamic interface again (also once)
You could do this using conditionalPanel and observe.
library(shiny)
if (interactive()) {
# Define UI
ui <- fluidPage(
actionButton("add", "Add UI"),
actionButton("remove", "Remove UI"),
conditionalPanel(condition = "input.add > 0",
uiOutput("textbox"))
)
# Server logic
server <- function(input, output, session) {
# adding UI
observe({
if (!is.null(input$add)) {
output$textbox <- renderUI({
div(
textInput("txt", "Insert some text"),
id="textinput"
)
})
}
})
# removing UI
observeEvent(input$remove, {
removeUI(selector = "#textinput")
})
}
shinyApp(ui, server)
}
EDIT - without conditionalPanel.
library(shiny)
if (interactive()) {
# Define UI
ui <- fluidPage(
actionButton("add", "Add UI"),
actionButton("remove", "Remove UI"),
uiOutput("textbox"))
# Server logic
server <- function(input, output, session) {
# adding UI
observeEvent(input$add,
output$textbox <- renderUI({
div(
textInput("txt", "Insert some text"),
id="textinput"
)
})
)
# removing UI
observeEvent(input$remove, {
removeUI(selector = "#textinput")
})
}
shinyApp(ui, server)
}