Search code examples
rshinyshinymodules

How to access user input from inside a module?


I am trying to access some user input that is defined within a module. In the code below, I have three pickerInput selections that cascade and depend on the previous one. The final pickerInput (Level3) will then filter the mpg dataset and display it below the three pickerInput items.

I am unsure of how to access the Level3 selection and utilize it in another part of the server, in this case using it as a filter for mpg.

Below is the code:

library(shiny)
library(tidyverse)
library(shinyWidgets)

multiFilterUI <- function(id){
    ns <- NS(id)
    
    tagList(
        fluidRow(
            column(3, uiOutput(ns("level1"))),
            column(3, uiOutput(ns("level2"))),
            column(3, uiOutput(ns("level3")))
        )
    )
}

multiFilterServer <- function(id, data, col1, col2, col3){
    moduleServer(
        id,
        function(input, output, session){
            output$level1 <- renderUI({
                ns <- session$ns
                cs <- unique(data[[col1]])
                
                pickerInput(ns("level1_select"), label = "Level1", choices = cs)
            })
            
            output$level2 <- renderUI({
                ns <- session$ns
                cs <- data %>% filter(!!sym(col1) %in% input$level1_select) %>%
                    distinct(!!sym(col2)) %>% 
                    pull(!!sym(col2))

                pickerInput(ns("level2_select"), label = "Level2", choices = cs)
            })
            
            output$level3 <- renderUI({
                ns <- session$ns
                cs <- data %>% filter(!!sym(col2) %in% input$level2_select) %>%
                    distinct(!!sym(col3)) %>% 
                    pull(!!sym(col3))
                
                pickerInput(ns("level3_select"), label = "Level3", choices = cs)
            })
        }
    )
}


ui <- fluidPage(
    multiFilterUI("test"),
    dataTableOutput("dt")
)

server <- function(input, output, session) {
    
    multiFilterServer("test", mpg, "manufacturer", "model", "trans")
    
    output$dt <- renderDataTable({
        mpg %>% filter(trans %in% input$level3_select)
    })
    
    
}

shinyApp(ui, server)

My attempt is to just access level3_select but it clearly doesn't work.


Solution

  • You need to return level3_select from the module as a reactive, you can do this with:

    return(list(
            level3_select = reactive({input$level3_select})
            ))
    

    Then in the main server function, you can store the return value of your module in a variable. When you access the reactive value, you need to evaluate it by adding ().

    library(shiny)
    library(tidyverse)
    library(shinyWidgets)
    
    multiFilterUI <- function(id){
      ns <- NS(id)
      
      tagList(
        fluidRow(
          column(3, uiOutput(ns("level1"))),
          column(3, uiOutput(ns("level2"))),
          column(3, uiOutput(ns("level3")))
        )
      )
    }
    
    multiFilterServer <- function(id, data, col1, col2, col3){
      moduleServer(
        id,
        function(input, output, session){
          output$level1 <- renderUI({
            ns <- session$ns
            cs <- unique(data[[col1]])
            
            pickerInput(ns("level1_select"), label = "Level1", choices = cs)
          })
          
          output$level2 <- renderUI({
            ns <- session$ns
            cs <- data %>% filter(!!sym(col1) %in% input$level1_select) %>%
              distinct(!!sym(col2)) %>% 
              pull(!!sym(col2))
            
            pickerInput(ns("level2_select"), label = "Level2", choices = cs)
          })
          
          output$level3 <- renderUI({
            ns <- session$ns
            cs <- data %>% filter(!!sym(col2) %in% input$level2_select) %>%
              distinct(!!sym(col3)) %>% 
              pull(!!sym(col3))
            
            pickerInput(ns("level3_select"), label = "Level3", choices = cs)
          })
          
          return(list(
            level3_select = reactive({input$level3_select})
            ))
        }
      )
    }
    
    
    ui <- fluidPage(
      multiFilterUI("test"),
      dataTableOutput("dt")
    )
    
    server <- function(input, output, session) {
      
      selection <- multiFilterServer("test", mpg, "manufacturer", "model", "trans")
      
      output$dt <- renderDataTable({
        mpg %>% filter(trans %in% selection$level3_select())
      })
      
      
    }
    
    shinyApp(ui, server)