How to pass value from one instance of shiny module to another instance of the same module?

Question

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.

Shiny applications not supported in static R Markdown documents

^{Created on 2023-06-27 by the reprex package (v2.0.1)}

YBS · Accepted Answer · 2023-06-28T13:10:18.193

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)

Thank you... this is still not what I expected. So what I expected is given a selection of region in the Region tab, a subset of districts is displayed as the options in the selectInput in Region tab. I have edited my initial code slightly adding the location dataframe, so given the selection of region "Morogoro" in the region tab, I expect options of only "Morogoro DC" or "Gairo DC" to be displayed as options in the district tab. When the region "Lindi" is selected, I expect options of "Kilwa DC" or "Lindi DC" in the district tab to be displayed. — Tumaini Kilimba, Jun 27 '23 at 08:54
Without a sample data frame, it is hard to imagine this requirement. — YBS, Jun 27 '23 at 18:25
the first expression after library imports is the sample data frame of locations which should cascade from region to district. ```locations = tribble( ~region,~district, "Morogoro","Morogoro DC", "Morogoro","Gairo DC", "Lindi","Tandahima DC", "Lindi", "Kilwa DC" )``` — Tumaini Kilimba, Jun 28 '23 at 09:30
Assume the application caters for 2 regions, X and Y. X has 2 districts and Y has 2 districts. You select region X in the Region tab from the selectInput. Now, the selectInput options in the District tab should only show the districts which belong to the region selected in tab 1. Does this make sense? 1 region can have multiple districts, and districts in tab 2 (the District tab) should be filtered by the region selected in tab 1 (the Region tab). — Tumaini Kilimba, Jul 01 '23 at 04:39

How to pass value from one instance of shiny module to another instance of the same module?

1 Answers1