I have created a contrived example of what I want to achieve. Basically, I have a modular shiny app with two tabs, Region and District. In the region tab, I want to display a table with the dataset dependent on the region selected in the dropdown menu. In the district tab I want to display a table again with the dataset dependent on both the region selected previously and the district selected in the dropdown menu of the district tab. The district displayed in the selectInput of the district tab should be dependent on the region selected in the Region tab
However, on trying to get the region selection in the region tabs dropdown menu to be accessible in the district tabs processing of what data to display is not working, I am sure due to scoping issues with modules. But this is a common enough workflow for me to believe there is an answer, and here I am. The code is as below:
UPDATED CODE TO CREATE LOCATIONS OBJECT FOR CLARITY
library(shiny)
library(shinydashboard)
#>
#> Attaching package: 'shinydashboard'
#> The following object is masked from 'package:graphics':
#>
#> box
library(tidyr)
locations = tribble(
~region,~district,
"Morogoro","Morogoro DC",
"Morogoro","Gairo DC",
"Lindi","Tandahima DC",
"Lindi", "Kilwa DC"
)
get_regional_dataset = function(region){
#browser()
if(region=="Morogoro"){
mtcars
}else{
iris
}
}
get_district_dataset = function(region,district){
#browser()
if(region=="Morogoro" & district=="Morogoro DC"){
mtcars
}else{
iris
}
}
table_UI1 <- function(id) {
ns <- NS(id)
tagList(
sidebarPanel(width = 2,
uiOutput(ns("selector")),
)
)
}
table_UI2 <- function(id) {
ns <- NS(id)
tagList(
mainPanel(
DT::dataTableOutput(ns('table'))
)
)
}
table_Server1 <- function(id) {
moduleServer(id,function(input, output, session) {
ns <- session$ns
output$selector <- renderUI({
if(id %in% c("ER_district")) {
#browser()
choices <- locations$district
label <- "Council"
}
else {
choices <- locations$region
label <- "Region"
}
selectInput(inputId=NS(id,"choice"),
label = label,
choices = choices)
})
return(reactive(input$choice))
})
}
table_Server <- function(id, mychoice, mychoice2) {
moduleServer(id,function(input, output, session) {
rv <- reactiveValues()
observe({
rv$reg <<- mychoice()
rv$dist <<- mychoice2()
if (!is.null(mychoice())) rv$df <- get_regional_dataset(rv$reg)
if(id=="ER_district"){
if (!is.null(mychoice2())) rv$df <- get_district_dataset(rv$reg,rv$dist)
}
})
output$table = DT::renderDataTable({
rv$df
})
})
}
ui = fluidPage(
tabsetPanel(id = 'cqi_indicators',
tabPanel('Region',
tabsetPanel(
id='region_indicators',
tabPanel("Early Retention",table_UI1("ER"), table_UI2("ER"))
)
),
tabPanel('District',
tabsetPanel(
id='district_indicators',
tabPanel("Early Retention",table_UI1("ER_district"), table_UI2("ER_district"))
)
)
)
)
server = function(input,output,session){
choice1 <- table_Server1("ER")
choice2 <- table_Server1("ER_district")
table_Server("ER", choice1, choice2)
table_Server("ER_district", choice1, choice2)
}
shinyApp(ui,server)
#> PhantomJS not found. You can install it with webshot::install_phantomjs(). If it is installed, please make sure the phantomjs executable can be found via the PATH variable.
Created on 2023-06-27 by the reprex package (v2.0.1)
In your case it is better to have a separate module for the second selectInput as it depends on first selection of region. Try this
locations = tribble(
~region,~district,
"Morogoro","Morogoro DC",
"Morogoro","Gairo DC",
"Lindi","Tandahima DC",
"Lindi", "Kilwa DC",
"Lindi", "Dummy DC"
)
library(shiny)
library(shinydashboard)
get_regional_dataset = function(region){
#browser()
if(region=="Morogoro"){
mtcars
}else{
iris
}
}
get_district_dataset = function(region,district){
#browser()
if(region=="Morogoro" & district=="Morogoro MC"){
mtcars
}else{
iris
}
}
table_UI1 <- function(id) {
ns <- NS(id)
tagList(
sidebarPanel(width = 2,
uiOutput(ns("selector")),
)
)
}
table_Server1 <- function(id) {
moduleServer(id,function(input, output, session) {
ns <- session$ns
output$selector <- renderUI({
choices <- unique(locations$region)
label <- "Region"
selectInput(inputId=NS(id,"choice"),
label = label,
choices = choices)
})
return(reactive(input$choice))
})
}
table_UI2 <- function(id) {
ns <- NS(id)
tagList(
sidebarPanel(width = 2,
uiOutput(ns("selector2")),
)
)
}
table_Server2 <- function(id,choice_reg) {
moduleServer(id,function(input, output, session) {
ns <- session$ns
output$selector2 <- renderUI({
df <- locations[locations$region==choice_reg(),]
choices <- unique(df$district)
label <- "Council"
selectInput(inputId=NS(id,"choiced"),
label = label,
choices = choices)
})
return(reactive(input$choiced))
})
}
table_UI <- function(id) {
ns <- NS(id)
tagList(
mainPanel(
DT::dataTableOutput(ns('table'))
)
)
}
table_Server <- function(id, mychoice, mychoice2) {
moduleServer(id,function(input, output, session) {
rv <- reactiveValues()
observe({
if (!is.null(mychoice())) rv$df <- locations[locations$region == mychoice(),] # get_regional_dataset(mychoice())
if(id=="ER_district"){
if (!is.null(mychoice2())) rv$df <- locations[locations$region == mychoice() & locations$district == mychoice2(),] ## get_district_dataset(mychoice(), mychoice2())
print(mychoice2())
print(mychoice())
}
})
output$table = DT::renderDataTable({
rv$df
})
})
}
ui = fluidPage(
tabsetPanel(id = 'cqi_indicators',
tabPanel('Region',
tabsetPanel(
id='region_indicators',
tabPanel("Early Retention",table_UI1("ER"), table_UI("ER"))
)
),
tabPanel('District',
tabsetPanel(
id='district_indicators',
tabPanel("Early Retention",table_UI2("ER_district"), table_UI("ER_district"))
)
)
)
)
server = function(input,output,session){
choice1 <- table_Server1("ER")
choice2 <- table_Server2("ER_district",choice1)
table_Server("ER", choice1, choice2)
table_Server("ER_district", choice1, choice2)
}
shinyApp(ui,server)