How to access the input values of a selectInput widget embedded in a DT table?

Question

I have a perfectly working shiny application which renders a DT table with one or more DT columns where the rows contain selectInput widgets.

Given a data frame df with one list column, I create the datatable as follows:

output$table <- renderDataTable({
            DT::datatable(df,  
                          escape = FALSE, rownames = FALSE, selection = 'none',
                          options = list(
                            sort = FALSE, paging = FALSE, searching = FALSE, dom = 't',
                            fixedheader = TRUE,
                            pageLength = 5,
                            preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
                            drawCallback = JS('function() { Shiny.bindAll(this.api().table().node());}')
                            ))
          })

The function that creates the selectInput widgets in the df columns would construct a unique inputId for each widget: for instance, pasteo("select_", rowID), where rowID would be the row number in the data frame df.

In my application the content of the list column is converted into a widget as follows:

CreateWidget <- function(data){
  widget <- apply(data, 1, function(x){
    ifelse(length(x$listcol) == 1 , x$listcol, as.character(selectizeInput(paste0("select_", x$row), choices = x$listcol,
                                                       label = NULL,
                                                       selected = 1,
                                                       width = '100%',
                                                       multiple = TRUE, # Make a direct selection
                                                       size = length(x$listcol))))
  })
}

Once the DT table has been rendered, I can make the appropriate selections in the selectInput widgets. Once selected, the selected values are then available at the server as:

input$select_1

This approach works well and I have a this shiny app in production.

Now I am trying to change my shiny app such that it uses modules (I am not experienced with using modules at all). I would have expected that just namespacing the inputId in the function that generates the selectInput widget would be sufficient.

CreateWidget <- function(data, ns){
  widget <- apply(data, 1, function(x){
    ifelse(length(x$listcol) == 1 , x$listcol, as.character(selectizeInput(ns(paste0("select_", x$row)), choices = x$listcol,
                                                       label = NULL,
                                                       selected = 1,
                                                       width = '100%',
                                                       multiple = TRUE, # Make a direct selection
                                                       size = length(x$listcol))))
  })
}

Where I use ns = session$ns in the server module, from where this function is called. For instance, if the module ID would be 'main', my input value would now be available as:

input$main-select_1

Or in my code: input[[ns(paste0("select_", row))]]

But alas, this is not working at all! In my module-based app, I cannot even see the input values associated with my selectInput widgets. I can check their IDs using the browser inspector, so I know they exist, but I cannot access them. I can see all other input objects, associated with other widgets and with the DT table.

Added a working representative example after ismirsehregal's request:

global.R

# module_server.R
library(shiny)
library(dplyr)
library(DT)

source("./R/modules/app_ui.R", local = TRUE)
source("./R/modules/app_server.R", local = TRUE)

ui.R

ui <- fluidPage(
  carTableUI("main")
)

server.R

# Module Server
server <- function(input, output, session) {
  carTableServer("main")
}

app_ui.R

# Module UI
carTableUI <- function(id) {
  ns <- NS(id)
  tagList(
    DTOutput(ns("car_table")),
    textOutput(ns("selected_cars"))
  )
}

app_server.R

# module_server.R


carTableServer <- function(id) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns
    
    # function to create a selectizeInput widget for the DT table
    CreateWidget <- function(cars, ns) {
      
      sel_widget <- apply(cars, 1, function(x){
        if (length(x$Type) == 1) {
          x$Type
        } else {
          as.character(
            selectizeInput(
              inputId = session$ns(paste0("car_sel_", x$Brand)),
              #inputId = paste0("car_sel_", x$Brand),
              choices = x$Type,
              label = NULL,
              selected = 1,
              width = '100%',
              multiple = TRUE,
              size = length(x$Type)
            )
          )
        }
      })
      return(sel_widget)
    }
    
    Cars <- tibble(
      Brand = c("Tesla", "Kia", "Toyota"),
      Model = c("Model X", "Seltos", "Corolla"),
      Type = list(
        list("normal car", "sports car", "luxury car"),
        list("normal car", "sports car", "luxury car"),
        list("normal car", "sports car", "luxury car")
      )
    )
    
    Cars$selectize <- CreateWidget(Cars, ns)
    glimpse(Cars) # check how the df looks like
    
    output$car_table <- renderDT({
      datatable(Cars[, c("Brand", "Model", "selectize")], 
                escape = FALSE, rownames = FALSE, selection = 'none',
                options = list(
                  paging = FALSE, 
                  searching = FALSE, 
                  dom = 't',
                  preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
                  drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); }')
                ))
    }, server = FALSE)
    
    # Reactive expression to collect selected values
    selected_cars <- reactive({
      browser()
      selected <- sapply(Cars$Brand, function(x) {
        input[[ns(paste0("car_sel_", x))]]
      })
      selected <- selected[!sapply(selected, is.null)]
    })
    
    # Output the selected values
    output$selected_cars <- renderText({
      selected_values <- selected_cars()
      if (length(selected_values) == 0) {
        "No cars selected"
      } else {
        paste("Selected cars:", paste(selected_values, collapse = ", "))
      }
    })
    
    observeEvent(input[["main-car_sel_Tesla"]],
                 print(input[["main-car_sel_Tesla"]])
    )
    
    # print all input objects to the console
    # observe({
    #   print(reactiveValuesToList(input))
    # })
    
  })
}

Answer 1

There are two issues I needed to address to get this working.

The first is described here:

The issue is that the selectize dependencies are attached to the element returned by selectInput() and don't survive the as.character() coercion. If you want to use selectize as in your reprex, you can include its dependencies somewhere on the page, at which point your example works correctly.

You need to "manually" attach selectize's dependencies to the UI when using them in a DataTable. Please see the findDependencies call below.

The second issue was, that in app_server.R you don't need to use ns() to access the inputs (selected_cars reactive):

global.R

# module_server.R
library(shiny)
library(dplyr)
library(DT)

source("./R/modules/app_ui.R", local = TRUE)
source("./R/modules/app_server.R", local = TRUE)

ui.R

ui <- fluidPage(
  htmltools::findDependencies(selectizeInput("dummy", label = NULL, choices = NULL)),
  carTableUI("main")
)

server.R

# Module Server
server <- function(input, output, session) {
  carTableServer("main")
}

app_ui.R

# Module UI
carTableUI <- function(id) {
  ns <- NS(id)
  tagList(
    DTOutput(ns("car_table")),
    textOutput(ns("selected_cars"))
  )
}

app_server.R

# module_server.R

carTableServer <- function(id) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns
    
    # function to create a selectizeInput widget for the DT table
    CreateWidget <- function(cars, ns) {
      
      sel_widget <- apply(cars, 1, function(x){
        if (length(x$Type) == 1) {
          x$Type
        } else {
          as.character(
            selectizeInput(
              inputId = session$ns(paste0("car_sel_", x$Brand)),
              #inputId = paste0("car_sel_", x$Brand),
              choices = x$Type,
              label = NULL,
              selected = 1,
              width = '100%',
              multiple = TRUE,
              size = length(x$Type)
            )
          )
        }
      })
      return(sel_widget)
    }
    
    Cars <- tibble(
      Brand = c("Tesla", "Kia", "Toyota"),
      Model = c("Model X", "Seltos", "Corolla"),
      Type = list(
        list("normal car", "sports car", "luxury car"),
        list("normal car", "sports car", "luxury car"),
        list("normal car", "sports car", "luxury car")
      )
    )
    
    Cars$selectize <- CreateWidget(Cars, ns)
    glimpse(Cars) # check how the df looks like
    
    output$car_table <- renderDT({
      datatable(Cars[, c("Brand", "Model", "selectize")], 
                escape = FALSE, rownames = FALSE, selection = 'none',
                options = list(
                  paging = FALSE, 
                  searching = FALSE, 
                  dom = 't',
                  preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
                  drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); }')
                ))
    }, server = FALSE)
    
    # Reactive expression to collect selected values
    selected_cars <- reactive({
      selected <- sapply(Cars$Brand, function(x) {
        input[[paste0("car_sel_", x)]]
      })
      selected <- selected[!sapply(selected, is.null)]
      selected
    })
    
    # observe({
    #   print(names(input))
    # })
    
    # Output the selected values
    output$selected_cars <- renderText({
      selected_values <- selected_cars()
      if (length(selected_values) == 0) {
        "No cars selected"
      } else {
        paste("Selected cars:", paste(selected_values, collapse = ", "))
      }
    })
    
    observeEvent(input[["main-car_sel_Tesla"]],
                 print(input[["main-car_sel_Tesla"]])
    )
    
    # print all input objects to the console
    # observe({
    #   print(reactiveValuesToList(input))
    # })
    
  })
}