Looping Shiny callModule only exports last value - r

Question

I am trying to build an app which; 1) calculates the number of boxes, based on a data.frame, 2) For each box, creates a UI and a corresponding module that will trigger events when the action buttons are clicked, using a subset of that data.frame.
If I am not being explicit enough; the app has n UI's and in each UI, x buttons. I want to loop callModule to create n server functions so when I click on action button in any given UI, I trigger an event specific to that UI.
The problem I am having is that the callModule function apparently does not duplicate itself in a for loop. Instead, I always get only the last id and dataframe (as if the callModule overwrites itself).
I hope I was explicit enough. Here is a MWE:
server.R
library(shinydashboardPlus)
library(shiny)
library(shinydashboard)
source('modules.R')
shinyServer(function(input, output, session) {
# dataframe filtered / updated
dtst <- reactive({
iris[1:input$filter_d, ]
})
# number of items rendered
output$ui <- renderUI({
r <- tagList()
for(k in 1:input$n){
r[[k]] <- u_SimpleTaskView(id = k, d = dtst()[k, ]) # <- grab a subset or column of df
}
r
})
for(y in 1:isolate({input$n})){
callModule(m_UpdateTask, id = y, d = dtst()[, y])
}
})
ui.R
dheader <- dashboardHeaderPlus(title = "s")
dsidebar <- dashboardSidebar(
sidebarMenu(
menuItem("tst", tabName = "tst", icon = icon("bolt"))
)
)
dbody <- dashboardBody(
tabItems(
tabItem(tabName = "tst",
numericInput("n", "number of ui and module pairs", value = 10),
numericInput("filter_d", "RANDOM FILTER", value = 100),
uiOutput("ui")
)
) )
dashboardPagePlus(
title = "s",
header = dheader,
sidebar = dsidebar,
body = dbody
)
modules.R
u_SimpleTaskView <- function(id, d){
ns <- NS(id)
if(length(d) < 5){
# nothing
}else{
renderUI({
tagList(
br(),
HTML(paste0("<strong>Rows: </strong>", "xxxx")),
numericInput("divider", label = "number of rows", value = 2),
br(),
actionButton("go", "go")
)
})
}
}
m_UpdateTask <- function(input, output, session, d){
observeEvent(input$go, {
showModal(
modalDialog(
HTML(paste0("unique: ", length(unique(d))/input$divider ) )
)
)
})
}

Answer 1

Besides not being really minimal (no need for libraries shinydashboardPlus or shinydashboard) there are a couple of issues with your code.
renderUI is a server function not a UI function
If you create controls in the module UI you have to use the namespace function, otherwise you cannot use them in your module server function.
As it is a bit too complicated for me to debug your code directly, let me give you an example from which you can see how to use modules in the way you wanted:
library(shiny)
library(glue)
mod_ui <- function(id, base_df) { ## 3
ns <- NS(id) ## 1
tagList(
helpText(glue("The input parameter 'base_df' has {NROW(base_df)} rows.")),
numericInput(ns("n"), "n:", 2),
textOutput(ns("out"))
)
}
mod <- function(input, output, session) {
get_nr <- reactive(input$n) ## 2
output$out <- renderText(glue("Number selected: {get_nr()}"))
return(list(get_nr = get_nr)) ## 4
}
ui <- fluidPage(
numericInput("n", "number of uis:", 2),
uiOutput("uis"),
textOutput("sum")
)
server <- function(input, output, session) {
handlers <- list()
output$uis <- renderUI({
ret <- lapply(seq.int(input$n),
function(i) mod_ui(glue("mod_{i}"),
data.frame(x = seq.int(i)))) ## 5
tagList(ret)
})
observe(
handlers <<- lapply(seq.int(input$n),
function(i) callModule(mod, glue("mod_{i}"))) ## 6
)
output$sum <- renderText({ ## 7
req(length(handlers) > 0)
m_sum <- sum(sapply(handlers, function(h) h$get_nr()))
glue("Sum of all n: {m_sum}")
})
}
shinyApp(ui, server)
Explanation
In mod_ui we define all the elements one module should have. note the use of ns() for the controls' ids to make use of the namespacing.
In mod (the module server function) we can access controls as we would in the main server function ( i.e. directly liek in input$n.
We can pass arguments to any of the module's functions (like base_df).
If we want to use some of the reactives in the main app, we shoudl return them from the modules server function.
In our main app we use a loop to create the desired number of modules.
We use an observer to store the handlers from the modules in a list
We can access the modules reactives via the handler which we defined earlier.
Update 2021
shiny 1.5.0 introduced an easier interface for modules. The code below uses this "new" interface:
library(shiny)
library(glue)
mod_ui <- function(id, base_df) {
ns <- NS(id)
tagList(
helpText(glue("The input parameter 'base_df' has {NROW(base_df)} rows.")),
numericInput(ns("n"), "n:", 2),
textOutput(ns("out"))
)
}
mod <- function(id) {
moduleServer(id,
function(input, output, session) {
get_nr <- reactive(input$n)
output$out <- renderText(glue("Number selected: {get_nr()}"))
return(list(get_nr = get_nr))
}
)
}
ui <- fluidPage(
numericInput("n", "number of uis:", 2),
uiOutput("uis"),
textOutput("sum")
)
server <- function(input, output, session) {
handlers <- list()
output$uis <- renderUI({
ret <- lapply(seq.int(input$n),
function(i) mod_ui(glue("mod_{i}"),
data.frame(x = seq.int(i))))
tagList(ret)
})
observe({
handlers <<- lapply(seq.int(input$n),
function(i) mod(glue("mod_{i}")))
})
output$sum <- renderText({
req(length(handlers) > 0)
m_sum <- sum(sapply(handlers, function(h) {
res <- h$get_nr()
if(is.null(res)) {
0
} else {
res
}
}))
glue("Sum of all n: {m_sum}")
})
}
shinyApp(ui, server)