rshinyshinymodules

How to pass shiny inputSelect values to server module


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)


Solution

  • 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:

    enter image description here

    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)