Shiny Modules: Handling a list of buttons

Question

I am trying to build an app that relies on a list of buttons created via lapply. I can successfully reference the buttons using observeEvent when I am not working with modularized code. However, when I try to use modules, the observeEvent doesn't work. I suspect it has something to do with how Shiny handles the namespace id's, but despite a couple of days of experimentation, I have not been able to solve the issue.

Below I will post first the non-modularized dummy app that does work (stolen from this other stack overflow question: R Shiny: How to write loop for observeEvent). Then I will share my existing modularized code that does not work.

Working non-modularized code:

library("shiny")
ui <- fluidPage(
  fluidRow(
    column(
      width = 6,
      lapply(
        X = 1:6,
        FUN = function(i) {
          sliderInput(inputId = paste0("d", i), label = i, min = 0, max = 10, value = i)
        }
      )
    ),
    column(
      width = 6,
      verbatimTextOutput(outputId = "test")
    )
  )
)
server <- function(input, output){

  vals <- reactiveValues()

  lapply(
    X = 1:6,
    FUN = function(i){
      observeEvent(input[[paste0("d", i)]], {
        vals[[paste0("slider", i)]] <- input[[paste0("d", i)]]
      })
    }
  )

  output$test <- renderPrint({
    reactiveValuesToList(vals)
  })
}
shinyApp(ui = ui, server = server)

Modularized Code that fails:

library(shiny)

slidersUI <- function(id){
  ns <- NS(id)
  tagList(

  fluidRow(
    column(
      width = 6,
      lapply(
        X = 1:6,
        FUN = function(i) {
          sliderInput(inputId = paste0("d", i), label = i, min = 0, max = 10, value = i)
        }    ),
    column(
      width = 6,
      verbatimTextOutput(outputId = "test")
    )

    
  )))
}

slidersServer <- function(input, output, session){
  vals <- reactiveValues()

    lapply(
    X = 1:6,
    FUN = function(i){
      output$test2 <- renderText(paste0("this is i:", i))
      observeEvent(input[[paste0("d", i)]], {
        vals[[paste0("slider", i)]] <- input[[paste0("d", i)]]
      })
    }
  )
  
  output$test <- renderPrint({
    reactiveValuesToList(vals)
  })
  
}


library("shiny")
ui <- fluidPage(
  slidersUI("TheID")
  
)
server <- function(input, output){
  callModule(slidersServer, "TheID")
}
shinyApp(ui = ui, server = server)

Thank you!

Answer 1

You need to wrap your IDs in ns to get the correct namespace. Here is the corrected module ui:

slidersUI <- function(id){
  ns <- NS(id)
  tagList(
    
    fluidRow(
      column(
        width = 6,
        lapply(
          X = 1:6,
          FUN = function(i) {
            sliderInput(inputId = ns(paste0("d", i)), label = i, min = 0, max = 10, value = i)
          }    ),
        column(
          width = 6,
          verbatimTextOutput(outputId = ns("test"))
        )
        
        
      )))
}