Access the value of a DT selectInput inside a shiny module

Question

I'm developping a Shiny App with various panels that I each separate into their own modules. One of them uses a DataTable with selectInput on various cells and whose value I need to access inside this same module. In the following example, I just try to display the selected value with output$mySelectOutput.

I'm sure that I am missing something regarding ns. I tried to add it before the inputId inside the selectInput, but this isn't enought.

Edit : I still haven't solved the issue, but I found two things that would have contributed to the app not working as intended.

• I forgot to add preDrawCallback and drawCallback options for the DataTable
• Using as.character(selectInput(...)) isn't working the way I thought and, from what I saw, it's not possible to retrieve the id of a selectInput generated that way. So I decided to roll-back instead to my homebrew generator (called mySelectInput) to which I tried to incorporate the ns()

Here is the reproducible example:

### Libraries

library(shiny)            # used to create the Shiny App
library(bslib)            # used to create the framework of the Shiny App
library(DT)               # used for creating interactive DataTable


# Create levels to choose from in the Select Input
factorOptions <- function(factor_levels) {
  optionList <- ""
  for (i in factor_levels) {optionList <- paste0(optionList, '<option value="', i, '">', i, '</option>\n')}
  return(optionList)
}

# Create the Select Input with ID and corresponding entry from the datatable
mySelectInput <- function(id_list, selected_factors, factor_levels) {
  select_input <- paste0('<select id="ns(single_select_', id_list, ')"style="width: 100%;">\n', 
                         sprintf('<option value="%s" selected>%s</option>\n', selected_factors, selected_factors), 
                         factorOptions(factor_levels), '</select>')
  return(select_input)
}


### Server

dummy_serverModule <- function(id) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns
    
    dummy_data <- datatable(
      data = tibble(select_test = mySelectInput(1, 1, 1:4)),
      selection = 'none', escape = FALSE, rownames = FALSE,
      options = list(
        keys = TRUE,
        preDrawCallback = JS('function(){Shiny.unbindAll(this.api().table().node());}'),
        drawCallback = JS('function(){Shiny.bindAll(this.api().table().node());}')
      )
    )
    
    output$dummyDT <- renderDT({dummy_data})
    output$mySelectOutput <- renderText({input$single_select_1})
  })
}

server <- function(input, output, session) {
  dummy_serverModule(id = "dummyId")
  
  session$onSessionEnded(function() {
    stopApp()
  })
}


### UI

dummy_uiModule <- function(id) {
  ns <- NS(id)
  
  page_fluid(
    card_body(DTOutput(ns("dummyDT"))),
    card(verbatimTextOutput(ns("mySelectOutput")))
  )
}

ui <- page_navbar(
  nav_panel(
    title = "Dashboard",
    dummy_uiModule(id = "dummyId")
  )
)


### App

shinyApp(ui, server)

Answer 1

Ok so I actually had the correct idea, but wrong execution. Since ns() acts as a function that adds the module ID before the input/output IDs, putting it in the string that generates the selectInput as a character string was not doing anything.

However, since ns basically a paste0 of the module ID and the input/output ID, I can replicate it by adding and id_module argument in mySelectInput and editing it like :

mySelectInput <- function(id_module, id_list, selected_factors, factor_levels) {
  select_input <- paste0('<select id="', id_module, '-single_select_', id_list, '"style="width: 100%;">\n', 
                         sprintf('<option value="%s" selected>%s</option>\n', selected_factors, selected_factors), 
                         factorOptions(factor_levels), '</select>')
  return(select_input)
}

That way, each selectInput generated in the DataTable is linked to the module and their value can properly be extracted.

Here is the full corrected code :

### Libraries

library(shiny)            # used to create the Shiny App
library(bslib)            # used to create the framework of the Shiny App
library(DT)               # used for creating interactive DataTable


# Create levels to choose from in the Select Input
factorOptions <- function(factor_levels) {
  optionList <- ""
  for (i in factor_levels) {optionList <- paste0(optionList, '<option value="', i, '">', i, '</option>\n')}
  return(optionList)
}

# Create the Select Input with ID and corresponding entry from the datatable
mySelectInput <- function(id_module, id_list, selected_factors, factor_levels) {
  select_input <- paste0('<select id="', id_module, '-single_select_', id_list, '"style="width: 100%;">\n', 
                         sprintf('<option value="%s" selected>%s</option>\n', selected_factors, selected_factors), 
                         factorOptions(factor_levels), '</select>')
  return(select_input)
}


### Server

dummy_serverModule <- function(id) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns
    
    dummy_data <- datatable(
      data = tibble(select_test = mySelectInput(id, 1, 1, 1:4)),
      selection = 'none', escape = FALSE, rownames = FALSE,
      options = list(
        keys = TRUE,
        preDrawCallback = JS('function(){Shiny.unbindAll(this.api().table().node());}'),
        drawCallback = JS('function(){Shiny.bindAll(this.api().table().node());}')
      )
    )
    
    output$dummyDT <- renderDT({dummy_data})
    output$mySelectOutput <- renderText({input$single_select_1})
  })
}

server <- function(input, output, session) {
  dummy_serverModule(id = "dummyId")
  
  session$onSessionEnded(function() {
    stopApp()
  })
}


### UI

dummy_uiModule <- function(id) {
  ns <- NS(id)
  
  page_fluid(
    card_body(DTOutput(ns("dummyDT"))),
    card(verbatimTextOutput(ns("mySelectOutput")))
  )
}

ui <- page_navbar(
  nav_panel(
    title = "Dashboard",
    dummy_uiModule(id = "dummyId")
  )
)


### App

shinyApp(ui, server)