Search code examples
rshinymoduleshinymodules

Capture selectize Input value in R shiny module


I am building a shiny app with a selectize input.
The choices in the input are dependent upon the ids in the underlying data.
In my real app, the data updates with a call to an API.
I would like the selected id choice in the selectize input to hold constant when I hit the "update data" button.

I was able to do this prior to using shiny modules. However, when I tried to transform my code to use a shiny module, it fails to hold the selected id value, and resets the selectize input each time I update the underlying data.

The following example was helpful without the module, but when I use the module it doesn't seem to work...link here

Below is a reprex. Thanks for any help.

library(shiny)
library(tidyverse)


# module UI

mymod_ui <- function(id){
      ns <- NS(id)
      tagList(
                
                uiOutput(ns("ids_lookup")),
                              
      )        
      
}


# module server

mymod_server <- function(input, output, session, data, actionb){
      ns <-session$ns
      
      ids <- reactive(
                
                data() %>%
                          filter(!is.na(first_name) & !is.na(last_name) & !is.na(ages)) %>%
                          mutate(ids = paste(first_name, last_name, sep = " ")) %>%
                          select(ids)
      )
      
      
      output$ids_lookup <- renderUI({
                
                selectizeInput(ns("lookup"), 
                               label = "Enter id:", 
                               choices = c("Type here ...", ids()), multiple = FALSE)
                
      })
      
      # here is where I would like to hold on to the selected ids when updating the table
      # when I click the "reload_data" button I don't want the name to change
      # I pass the button from the main server section into the module
      
      current_id_selection <- reactiveVal("NULL")
      
      observeEvent(actionb(), {
                
                current_id_selection(ns(input$ids_lookup))
                
                updateSelectizeInput(session, 
                                     inputId = ns("lookup"), 
                                     choices = ids(), 
                                     selected = current_id_selection())
      })
     
}


ui <- fluidPage(
      titlePanel("Test module app"),
      br(),
      
      # this button reloads the data
      actionButton(
                
                inputId = "reload_data", 
                label = "Reload data"
      ),
      br(),
      br(),
      
      # have a look at the data
      h4("Raw data"),
      tableOutput("mytable"),
      
      br(),
      
      # now select a single id for further analysis in a much larger app
      mymod_ui("mymod"), 
      
      
)


server <- function(input, output, session) {
      
     
      
      df <- eventReactive(input$reload_data, {
                
                # in reality, df is a dataframe which is updated from an API call everytime you press the action button
                
                df <- tibble(
                          first_name = c("john", "james", "jenny", "steph"),
                          last_name = c("x", "y", "z", NA),
                          ages = runif(4, 30, 60)
                )
      
                
                return(df)
                
      }
      )
      
      
      output$mytable <- renderTable({
                
                df()
                
      })
      
      
      # make the reload data button a reactive val that can be passed to the module for the selectize Input
      
      mybutton <- reactive(input$reload_data)
      
      callModule(mymod_server, "mymod", data = df, actionb = mybutton)
      

      
      
}


shinyApp(ui, server)

Solution

  • Just using inputId = "lookup" instead of inputId = ns("lookup") in updateSelectizeInput() will do it. Also, you had another typo in there. Try this

    library(shiny)
    library(tidyverse)
    
    
    # module UI
    
    mymod_ui <- function(id){
      ns <- NS(id)
      tagList(
        uiOutput(ns("ids_lookup")),
        verbatimTextOutput(ns("t1"))
      )        
      
    }
    
    
    # module server
    
    mymod_server <- function(input, output, session, data, actionb){
      ns <-session$ns
      
      ids <- reactive(
        
        data() %>%
          filter(!is.na(first_name) & !is.na(last_name) & !is.na(ages)) %>%
          mutate(ids = paste(first_name, last_name, sep = " ")) %>%
          select(ids)
      )
      
      
      output$ids_lookup <- renderUI({
        
        selectizeInput(ns("lookup"), 
                       label = "Enter id:", 
                       choices = c("Type here ...", ids()), multiple = FALSE)
        
      })
      
      # here is where I would like to hold on to the selected ids when updating the table
      # when I click the "reload_data" button I don't want the name to change
      # I pass the button from the main server section into the module
      
      current_id_selection <- reactiveValues(v=NULL)
      
      observeEvent(actionb(), {
        req(input$lookup)
        current_id_selection$v <- input$lookup
        
        output$t1 <- renderPrint(paste0("Current select is ",current_id_selection$v))
        
        updateSelectizeInput(session, 
                             inputId = "lookup", 
                             choices =  ids(), 
                             selected = current_id_selection$v )
      })
      
    }
    
    
    ui <- fluidPage(
      titlePanel("Test module app"),
      br(),
      
      # this button reloads the data
      actionButton(inputId = "reload_data", label = "Reload data"
      ),
      br(),
      br(),
      
      # have a look at the data
      h4("Raw data"),
      tableOutput("mytable"),
      
      br(),
      
      # now select a single id for further analysis in a much larger app
      mymod_ui("mymod")
      
    )
    
    
    server <- function(input, output, session) {
      
      df <- eventReactive(input$reload_data, {
        
        # in reality, df is a dataframe which is updated from an API call everytime you press the action button
        
        df <- tibble(
          first_name = c("john", "james", "jenny", "steph"),
          last_name = c("x", "y", "z", NA),
          ages = runif(4, 30, 60)
        )
        
        return(df)
        
      })
      
      
      output$mytable <- renderTable({
        
        df()
        
      })
      
      
      # make the reload data button a reactive val that can be passed to the module for the selectize Input
      
      mybutton <- reactive(input$reload_data)
      
      callModule(mymod_server, "mymod", data = df, actionb = mybutton)
      
    }
    
    shinyApp(ui, server)
    

    output