Server-side selectize not working in R Shiny app

Question

Here is the main / only docs on server-side selectize from RStudio. Following the example in this article, I have created the example below. The main goal of the code below is to render the input as a server-size selectize input. Note that the fetching of options for the select happens globally near the top of our app.R file - we fetch data for the named character vector namelist_nba, which we use as the value for choices. For reproducibility, I have commented out our data fetching code & have hard-coded the top 20 responses:

app.R - you should be able to run this.

rm(list = ls())

# Fetch Options for Selectize Input

# source('scripts/pingDB.R')
# sql__namelist_nba <<- paste(readLines("sql/nba/namelist_nba.txt"), collapse=" ")
# namelist_nba <<- getData(sql__namelist_nba)
# namelist_nba <<- namelist_nba[order(namelist_nba$full_name), ]
# namelist_nba <<- setNames(namelist_nba$player_id, namelist_nba$full_name)

# hardcode first 20 results for stackoverflow post
namelist_nba <- c(`A.C. Green` = 920L, `A.J. Bramlett` = 1920L, `A.J. Davis` = 203667L, 
  `A.J. Guyton` = 2062L, `Aaron Best` = 1628700L, `Aaron Brooks` = 201166L, 
  `Aaron Craft` = 203905L, `Aaron Epps` = 1629200L, `Aaron Gordon` = 203932L, 
  `Aaron Gray` = 201189L, `Aaron Harrison` = 1626151L, `Aaron Holiday` = 1628988L, 
  `Aaron Jackson` = 1628935L, `Aaron Johnson` = 203638L, `Aaron McKie` = 243L, 
  `Aaron Miles` = 101223L, `Aaron Nesmith` = 1630174L, `Aaron Pettway` = 202925L, 
  `Aaron Thomas` = 1628045L, `Aaron White` = 1626206L)


# create body and sidebar
ui_body <- dashboardBody()

# note use of NS() and modules
ns2 <- NS('nba_player_profile')
ui_sidebar <- dashboardSidebar(
  
  sidebarMenu(
      id = "sidebarMenu",
      menuItem("These Pages", tabName = "team",
        menuSubItem("Player Profile", tabName = "player_profile_nba"),
        conditionalPanel(
          "input.sidebarMenu === 'player_profile_nba'",
          class = NULL,
          selectizeInput(inputId = ns2("player_input"), label = 'Player Search: ', choices = NULL)
        )
      )
  )
)

# server module for "player profile" page
server__player_profile <- function(id) {
  moduleServer(
    id,
    function(input, output, session) {
      updateSelectizeInput(
        session, 
        inputId = session$ns('player_input'), 
        choices = namelist_nba,
        selected = namelist_nba[1],
        server = TRUE)
    }
  )
}

# shinyserver is where we combine all of our server modules...
server <- shinyServer(function(input, output, session) {
  observeEvent(input$sidebarMenu, {
    print(paste0("sidebarMenu tabName: ", input$sidebarMenu))
  })

  server__player_profile(id = 'nba_player_profile')
})

# ui is where we combine header,sidebar,body
ui <- dashboardPage(
  title="Dashboard Title",
  dashboardHeader(
    title = div("Our Databoard header title"), 
    titleWidth = 300),
  ui_sidebar, ui_body
)

# and return / run the app
app <- shinyApp(ui = ui, server = server)
runApp(app)

When we run this app, the select input currently does not work at all. I cannot type in player names, and clicking on the box shows no dropdown (although it does show a tiny, empty dropdown for a fraction of a second). How can we update our code so that server-side selectize works here?

Note that our code example is made a bit more complex by our use of shiny modules, which is all documented here.

Answer 1

While the updateSelectizeInput() does not seem to work, you can call selectizeInput inside a renderUI and make it work. Try this

namelist_nba <- c(`A.C. Green` = 920L, `A.J. Bramlett` = 1920L, `A.J. Davis` = 203667L, 
                  `A.J. Guyton` = 2062L, `Aaron Best` = 1628700L, `Aaron Brooks` = 201166L, 
                  `Aaron Craft` = 203905L, `Aaron Epps` = 1629200L, `Aaron Gordon` = 203932L, 
                  `Aaron Gray` = 201189L, `Aaron Harrison` = 1626151L, `Aaron Holiday` = 1628988L, 
                  `Aaron Jackson` = 1628935L, `Aaron Johnson` = 203638L, `Aaron McKie` = 243L, 
                  `Aaron Miles` = 101223L, `Aaron Nesmith` = 1630174L, `Aaron Pettway` = 202925L, 
                  `Aaron Thomas` = 1628045L, `Aaron White` = 1626206L)



ui_player_profile <- function(id) {
  ns <- NS(id)
  tagList(
    uiOutput(ns("playerinput"))
    #selectInputize(inputId = ns("player_input"), label = 'Player Search: ', choices = NULL)
  )
}

# server module for "player profile" page
server_player_profile <- function(id) {
  moduleServer(
    id,
    function(input, output, session) {
      ns <- session$ns
     
        # updateSelectizeInput(
        #   session, 
        #   inputId = ns('player_input'), 
        #   #inputId = session$ns('player_input'),
        #   choices = namelist_nba,
        #   selected = namelist_nba[1] #, server = TRUE
        #   )
     
      output$playerinput <- renderUI({
        selectizeInput(inputId = ns("player_input"), label = 'Player Search: ', choices = namelist_nba, selected = namelist_nba[1])
      })
      
    }
  )
}

# create body and sidebar
ui_body <- dashboardBody()

# note use of NS() and modules

ui_sidebar <- dashboardSidebar(
  
  sidebarMenu(
    id = "sidebarMenu",
    menuItem("These Pages", tabName = "team",
             menuSubItem("Player Profile", tabName = "player_profile_nba"),
             # conditionalPanel(
             #   "input.sidebarMenu === 'player_profile_nba'",
             #   class = NULL,
             ui_player_profile('nba_player_profile')
             
             # )
    )
  )
)

# ui is where we combine header,sidebar,body
ui <- dashboardPage(
  title="Dashboard Title",
  dashboardHeader(
    title = div("Our Databoard header title"), 
    titleWidth = 300),
  ui_sidebar, 
  ui_body
)

# shinyserver is where we combine all of our server modules...
server <- shinyServer(function(input, output, session) {
  observeEvent(input$sidebarMenu, {
    print(paste0("sidebarMenu tabName: ", input$sidebarMenu))
  })
  
  server_player_profile(id = 'nba_player_profile')
})


# and return / run the app
shinyApp(ui = ui, server = server)