闪亮：跨选项卡面板循环创建表格的更好方法

Question

我必须创建一个 Shiny/ShinyDashboard 应用程序，它基本上为不同的团队创建了一堆表格。用户将从侧边栏 select 他们的团队，然后他们将有几个选项卡面板可供选择，具体取决于数据。看这里：

现在的要求是我必须将每个选项卡面板的数据拆分为不同的数据表，并且 - 由于数据 - 我必须动态生成它。

我想出了下面的代码（reprex 在这里）但是因为我对 Shiny 很陌生，我想知道是否：

我可以拆分 UI 和数据代码甚至更多
坦率地说，有更好的方法可以做到这一点

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

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",
                         uiOutput("Team1_content_A")),
                tabPanel(title = "B",
                         uiOutput("Team1_content_B"))
              )
            )),
    tabItem(tabName = "tab_team2",
            fluidRow(
              tabBox(
                title = "",
                width = "100%",
                tabPanel(title = "A",
                         uiOutput("Team2_content_A")),
                tabPanel(title = "B",
                         uiOutput("Team2_content_B"))
              )
            ))
  ))
)



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

  lapply(1:2, function(i) {
    t <- paste0("Team", i)
    
    table <- cars %>%
      filter(team == t)
    
    output[[paste0(t, "_content_A")]] <- renderUI({
      lapply(sort(unique(table$gear)), function(i) {
        id <- paste0(t, "_content_A_", i)
        
        output[[id]] <-
          DT::renderDataTable(datatable(table[table$gear == i, ]))
        
        fluidRow(
          box(
            width = "100%",
            title = paste0("Gears: ", i),
            status = "info",
            solidHeader = TRUE,
            collapsible = TRUE,
            DT::dataTableOutput(id)
          )
        )
      })
    })
    
    table2 <- irises %>%
      filter(team == t)
    
    output[[paste0(t, "_content_B")]] <- renderUI({
      lapply(sort(unique(table2$Species)), function(i) {
        id <- paste0(t, "_content_B_", i)
        
        output[[id]] <-
          DT::renderDataTable(datatable(table2[table2$Species == i, ]))
        
        fluidRow(
          box(
            width = "100%",
            title = paste0("Species: ", i),
            status = "info",
            solidHeader = TRUE,
            collapsible = TRUE,
            DT::dataTableOutput(id)
          )
        )
      })
    })
  })
}
shinyApp(ui, server)

Answer 1

回复@Limey，我也建议使用闪亮的模块https://mastering-shiny.org/scaling-modules.html。有两个原因。

减少不必要的计算。当前所有四个面板（team1_tabA、team1_tabB、team2_tabA、team2_tabB）的计算同时为运行。理想情况下，当您将来添加更多功能或数据时，您可能只想运行在执行某些操作时进行必要的计算。（即当用户点击 team1_tabA 时，只计算需要的表，不需要为其他选项卡计算表。）。模块可以帮助实现它。

更灵活地控制 UI 和服务器。目前，您的应用程序对所有四个面板具有相同的服务器功能和输出，目前可以使用。但如果将来您希望四个面板具有不同的布局和输出，当前的编码风格可能会提示您编写更复杂和重复的代码。而模块可以帮助你摆脱重复，帮助更灵活地控制UI和服务器。

这是您闪亮的应用程序的模块化版本。我在动态UI(renderUI)中使用命名空间(NS(id))遇到了一些问题，感谢@YBS的反馈，问题已经解决，并且模块化的 shiny 能够运行.

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

## module Server
tab_server <- function(id, data, Team, var) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns ## call namespace in the server

    table <- reactive({
      data %>% filter(team == Team)
    })

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

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

        fluidRow(
          box(
            width = "100%",
            title = paste0(var, " ", i),
            status = "info",
            solidHeader = TRUE,
            collapsible = TRUE,
            DT::dataTableOutput(ns(idd)) ## !!! need to use namespace
          )
        )
      })
    })
  })
}

## 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)


## 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)

闪亮：跨选项卡面板循环创建表格的更好方法

shiny: better way to create tables in loop across tab panels

r

shiny

shinydashboard