How to pass shiny inputSelect values to server module

Question

I have shiny code similar to the contrived example below. My intention is that in the server part, I pass on inputSelect values dynamically as arguments to the table_Server function like below (does not work):

# Line 94 of code
server = function(input,output,session){
  
  table_Server("ER", input$region_choice)
}

Instead, I have to hard code the region as shown next:

# Line 94 of code
server = function(input,output,session){
  
  table_Server("ER", "Morogoro)
}

The full running code (hardcoded) is as below, any suggestions appreciated.

library(shiny)
library(shinydashboard)
#> 
#> Attaching package: 'shinydashboard'
#> The following object is masked from 'package:graphics':
#> 
#>     box

get_dataset = function(region){
  if(region=="Morogoro"){
    mtcars
  }else{
    iris
  }
}

get_reg_rate = function(region){
  data.frame(
    region="Morogoro",
    numerator=459,
    denominator=541,
    green_gap=80,
    yellow_gap=77,
    message="Regional Performance"
  )
}

table_UI <- function(id) {
  ns <- NS(id)
  tagList(
    sidebarLayout(
      sidebarPanel(width = 2,
                   uiOutput(ns("selector")),
      ),
      mainPanel(
        valueBoxOutput(ns('regional_value')),
        valueBoxOutput(ns('green_gap_value')),
        valueBoxOutput(ns('yellow_gap_value')),
        DT::dataTableOutput(ns('table'))
      )
    )
  )
}

table_Server <- function(id, region) {
  moduleServer(id,function(input, output, session) {
    
    ds=get_dataset(region)
    rate=get_reg_rate(region)
    
    output$table = DT::renderDataTable({
      ds
    })
    
    output$regional_value <- renderValueBox({
      valueBox(
        rate$rate,
        rate$message
      )
    })
    
    if(!id %in% c("DE","Score_district","DE_district")){
      output$green_gap_value <- renderValueBox({
        valueBox(
          rate$green_gap,
          "Green Gap"
        )
      })
      
      output$yellow_gap_value <- renderValueBox({
        valueBox(
          rate$yellow_gap,
          "Yellow Gap"
        )
      })
    }
    output$selector=renderUI({
      selectInput(inputId=NS(id,"region_choice"),
                  label="Region",
                  choices = c("Morogoro","Lindi","Mtwara","Njombe","Ruvuma",
                              "Iringa"),selected = "Morogoro" )
    })
  }
  )
}

ui = fluidPage(
  tabsetPanel(id = 'cqi_indicators',
              tabPanel('Region',
                       tabsetPanel(
                         id='region_indicators',
                         tabPanel("Early Retention",table_UI("ER"))
                       )
              )
              
  )
)

server = function(input,output,session){

  table_Server("ER", "Morogoro")
}


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-17 by the reprex package (v2.0.1)}

Answer 1

After calling table_Server("ER", input$region_choice) the value of input$region_choice does not exist yet ->

Access input$region_choice from inside the module server function.

Use observeEvent to make the renderDataTable and renderValueBox reactive to input$region_choice when it changes:

library(shiny)
library(shinydashboard)


get_dataset = function(region){
  if(region=="Morogoro"){
    mtcars
  }else{
    iris
  }
}

get_reg_rate = function(region){
  data.frame(
    region="Morogoro",
    numerator=459,
    denominator=541,
    green_gap=80,
    yellow_gap=77,
    message="Regional Performance"
  )
}

table_UI <- function(id) {
  ns <- NS(id)
  tagList(
    sidebarLayout(
      sidebarPanel(width = 2,
                   uiOutput(ns("selector")),
      ),
      mainPanel(
        valueBoxOutput(ns('regional_value')),
        valueBoxOutput(ns('green_gap_value')),
        valueBoxOutput(ns('yellow_gap_value')),
        DT::dataTableOutput(ns('table'))
      )
    )
  )
}

table_Server <- function(id, input) {
  moduleServer(id,function(input, output, session) {
    
    observeEvent(input$region_choice,{
      ds = get_dataset(input$region_choice)
      rate = get_reg_rate(input$region_choice)
      
      output$table = DT::renderDataTable({
        ds
      })
      
      output$regional_value <- renderValueBox({
        valueBox(
          rate$rate,
          rate$message
        )
      })
      
      if(!id %in% c("DE","Score_district","DE_district")){
        output$green_gap_value <- renderValueBox({
          valueBox(
            rate$green_gap,
            "Green Gap"
          )
        })
        
        output$yellow_gap_value <- renderValueBox({
          valueBox(
            rate$yellow_gap,
            "Yellow Gap"
          )
        })
      }
    })
    
    output$selector=renderUI({
      selectInput(inputId=NS(id,"region_choice"),
                  label="Region",
                  choices = c("Morogoro","Lindi","Mtwara","Njombe","Ruvuma",
                              "Iringa"),selected = "Morogoro" )
    })
  })
}

ui = fluidPage(
  tabsetPanel(id = 'cqi_indicators',
              tabPanel('Region',
                       tabsetPanel(
                         id='region_indicators',
                         tabPanel("Early Retention",table_UI("ER"))
                       )
              )
              
  )
)

server = function(input,output,session){
  
  table_Server("ER", input)
}

shinyApp(ui,server)