I was trying to modularize the shiny app proposed in this stack overflow question shiny: better way to create tables in loop across tab panels. Here below is the modularized reprex code (different from the original one in the linked post, but share the same structure). However, the output is empty. I couldn't figure out what's the issue here, I suspect that might have something to do with the id in the dynamic UI renderUI part, where both output[[id]] = renderDataTable() and DataTableOutput(id) occur (normally render* function appears in the server, while *Output appears in the UI.).

I understand that when use shiny modules, we have to use NS(id, 'name') for output element in UI. Here it seems like we cannot do the same, i.e. output[[NS(id, 'name')]], in the server dynamic UI. I am not sure if this could be the issue.

I appreciate if there is any suggestions. Thanks.

## library
library(shiny)
library(shinydashboard)
library(datasets)
library(dplyr)
library(DT)

## data
cars <- mtcars
irises <- iris
cars$team <- sample(c("Team1", "Team2"), nrow(cars), replace = TRUE)
irises$team <-
  sample(c("Team1", "Team2"), nrow(irises), replace = TRUE)

## module UI
tab_ui <- function(id) {
  uiOutput(NS(id, "content"))
}

## module Server
tab_server <- function(id, data, Team, var) {
  moduleServer(id, function(input, output, session) {
    table <- reactive({
      data %>% filter(team == Team)
    })

    output$content <- renderUI({
      lapply(sort(unique(table()[[var]])), function(i) {
        id <- paste0("content_", i)

        output[[id]] <-
          DT::renderDataTable(datatable(table()[table()[[var]] == i, ]))

        fluidRow(
          box(
            width = "100%",
            title = paste0(var, " ", i),
            status = "info",
            solidHeader = TRUE,
            collapsible = TRUE,
            DT::dataTableOutput(id)
          )
        )
      })
    })
  })
}

## UI
ui <- dashboardPage(
  dashboardHeader(title = "Teams"),
  dashboardSidebar(sidebarMenu(
    menuItem("Team 1",
      tabName = "tab_team1"
    ),
    menuItem("Team 2",
      tabName = "tab_team2"
    )
  )),
  dashboardBody(tabItems(
    tabItem(
      tabName = "tab_team1",
      fluidRow(
        tabBox(
          title = "",
          width = "100%",
          tabPanel(
            title = "A",
            tab_ui("team1_tabA")
          ), # module ui
          tabPanel(
            title = "B",
            tab_ui("team1_tabB")
          ) # module ui
        )
      )
    ),
    tabItem(
      tabName = "tab_team2",
      fluidRow(
        tabBox(
          title = "",
          width = "100%",
          tabPanel(
            title = "A",
            tab_ui("team2_tabA")
          ), # module ui
          tabPanel(
            title = "B",
            tab_ui("team2_tabB")
          ) # module ui
        )
      )
    )
  ))
)

## server
server <- function(input, output, session) {

  # module server
  tab_server("team1_tabA", data = cars, Team = "Team1", var = "gear")
  tab_server("team1_tabB", data = irises, Team = "Team1", var = "Species")
  tab_server("team2_tabA", data = cars, Team = "Team2", var = "gear")
  tab_server("team2_tabB", data = irises, Team = "Team2", var = "Species")
}

shinyApp(ui, server)

CodePudding user response：

Try this

team_ui <- function(id) {
  ns <- NS(id)
  fluidRow(
    column(12,
           shinydashboard::box(width=12,
             title = "My Table",
              uiOutput(ns("Team_content"))
           )
    )
  )
}

team_server <- function(id,df,t,var) {
  moduleServer(
    id,
    function(input, output, session) {
      ns <- session$ns
      table <- df %>% dplyr::filter(team == as.character(t))
      
      output$Team_content <- renderUI({
        lapply(sort(unique(table[[as.character(var)]])), function(i) {
          idd <- paste0(t, "_content_A_", i)
          
          output[[idd]] <- DT::renderDataTable(datatable(table[table[[as.character(var)]] == i, ]))
          
          fluidRow(
            box(
              width = "100%",
              title = paste0(as.character(var),": ", i),
              status = "info",
              solidHeader = TRUE,
              collapsible = TRUE,
              DT::dataTableOutput(ns(idd))
            )
          )
        })
      })
      
    })
}
    

cars <- mtcars
irises <- iris
cars$team <- sample(c("Team1", "Team2"), nrow(cars), replace = TRUE)
irises$team <-
  sample(c("Team1", "Team2"), nrow(irises), replace = TRUE)

# UI
ui <- dashboardPage(
  dashboardHeader(title = "Teams"),
  dashboardSidebar(sidebarMenu(
    menuItem("Team 1",
             tabName = "tab_team1",
             icon = icon("dashboard")),
    menuItem("Team 2",
             tabName = "tab_team2",
             icon = icon("dashboard"))
  )),
  dashboardBody(tabItems(
    tabItem(tabName = "tab_team1",
            fluidRow(
              tabBox(
                title = "",
                width = "100%",
                tabPanel(title = "A", team_ui("Team1_content_A")),
                tabPanel(title = "B", team_ui("Team1_content_B"))
              )
            )) ,
    tabItem(tabName = "tab_team2",
            fluidRow(
              tabBox(
                title = "",
                width = "100%",
                tabPanel(title = "A", team_ui("Team2_content_A")),
                tabPanel(title = "B", team_ui("Team2_content_B"))
              )
            ))
  ))
)



server <- function(input, output, session) {
 
  team_server("Team1_content_A",cars,"Team1",'gear')
  team_server("Team1_content_B",irises,"Team1",'Species')
  team_server("Team2_content_A",cars,"Team2",'gear')
  team_server("Team2_content_B",irises,"Team2",'Species')
  
}
shinyApp(ui, server)