how to display dynamic tabPanels with DT inside multiple nested modules - r

Question

I really need help on the following code, I use 2 nested modules to display sampledata in multiple tabPanels (inside tabsetPanel) by certain columns, but the table is not display, I cant found any bugs inside yet.
PS: this is just an reproducible example, the sampledata is uploaded by user in real scenario
library(shiny)
library(shinydashboard)
library(DT)
ui <- function() {
dashboardPage(
dashboardHeader(title = "abc"),
dashboardSidebar(uiOutput("sidebarpanel")),
dashboardBody(uiOutput("body")))
}
server <- function(input, output, session) {
output$sidebarpanel <- renderUI({
tags$div(
sidebarMenu(id = "tabs",
menuItem("Data", tabName = "data"))
)
})
output$body <- renderUI({
tabItems(ui_data1("data1", tabName = "data"))
})
input_data1 <- new.env()
input_data1$a <- reactive(1)
input_data1$b <- reactive(2)
input_data2 <- server_data1("data1", input_data1)
}
ui_data1 <- function(id, tabName){
ns <- NS(id)
tabItem(tabName = tabName,
uiOutput(ns("body")))
}
server_data1 <- function(id, input_data1) {
ns <- NS(id)
moduleServer(id, function(input, output, session) {
output$body <- renderUI({
tabsetPanel(
ui_data2(ns("info1"), "Info1")
)
})
data2 <- new.env()
data2$input_data2 <- server_data2("info1", input_data1)
return(data2)
})
}
ui_data2 <- function(id, title) {
ns <- NS(id)
tabPanel(title = title,
uiOutput(ns("body")))
}
server_data2 <- function(id, input_data1) {
ns <- NS(id)
moduleServer(id, function(input, output, session) {
c <- eventReactive(input_data1$a(), {
2
})
sampledata <- reactive(mtcars)
output$body <- renderUI({
all_cyl <- unique(sampledata()$cyl)
tbl_by_cyl <- lapply(seq_along(all_cyl), function(i) {
tabPanel(all_cyl[i],
column(12, br(),
box(width = "auto",
DT::dataTableOutput(ns(paste0("cyl", i)),
width = "100%"))))
})
do.call(tabsetPanel, tbl_by_cyl)
})
observe({
sampledata <- sampledata()
all_cyl <- unique(sampledata$cyl)
lapply(seq_along(all_cyl), function(i) {
output[[paste0("cyl", i)]] <- DT::renderDataTable({
datatable(sampledata[sampledata$cyl == all_cyl[i], ])
})
})
})
return(sampledata)
})
}
shinyApp(ui, server)
output:
output of above code

Answer 1

You were very close. You just needed ns <- session$ns in server_data1 and server_data2. Try this
library(shiny)
library(shinydashboard)
library(DT)
ui <- function() {
dashboardPage(
dashboardHeader(title = "abc"),
dashboardSidebar(uiOutput("sidebarpanel")),
dashboardBody(uiOutput("body")))
}
server <- function(input, output, session) {
output$sidebarpanel <- renderUI({
tags$div(
sidebarMenu(id = "tabs",
menuItem("Data", tabName = "data"))
)
})
output$body <- renderUI({
tabItems(ui_data1("data1", tabName = "data"))
})
input_data1 <- new.env()
input_data1$a <- reactive(1)
input_data1$b <- reactive(2)
input_data2 <- server_data1("data1", input_data1)
}
ui_data1 <- function(id, tabName){
ns <- NS(id)
tabItem(tabName = tabName,
uiOutput(ns("body1")))
}
server_data1 <- function(id, input_data1) {
#ns <- NS(id)
moduleServer(id, function(input, output, session) {
ns <- session$ns
output$body1 <- renderUI({
tabsetPanel(
ui_data2(ns("info1"), "Info1")
)
})
data2 <- new.env()
data2$input_data2 <- server_data2("info1", input_data1)
return(data2)
})
}
ui_data2 <- function(id, title) {
ns <- NS(id)
tabPanel(title = title,
uiOutput(ns("body2")))
}
server_data2 <- function(id, input_data1) {
#ns <- NS(id)
moduleServer(id, function(input, output, session) {
ns <- session$ns
c <- eventReactive(input_data1$a(), {
2
})
sampledata <- reactive(mtcars)
output$body2 <- renderUI({
all_cyl <- unique(sampledata()$cyl)
tbl_by_cyl <- lapply(seq_along(all_cyl), function(i) {
tabPanel(all_cyl[i],
fluidRow(column(12, br(),
shinydashboard::box( width = "auto",
DTOutput(ns(paste0("cyl", i)),width = "100%")))))
})
do.call(tabsetPanel, tbl_by_cyl)
})
observe({
sampledata <- sampledata()
all_cyl <- unique(sampledata$cyl)
lapply(seq_along(all_cyl), function(i) {
output[[paste0("cyl", i)]] <- renderDT({
datatable(sampledata[sampledata$cyl == all_cyl[i], ])
})
})
})
return(sampledata)
})
}
shinyApp(ui, server)