闪亮：在选项卡面板之间循环创建表格的更好方法 [英] shiny: better way to create tables in loop across tab panels

问题描述

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

现在的要求是，我必须将每个选项卡面板的数据拆分到不同的数据表中，并且由于数据的缘故，我必须动态生成这些数据表。

我想出了以下代码(这里是reprex)，但由于我对Showy还很陌生，我想知道是否：

• 我可以更好地拆分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)

推荐答案

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

1. 减少不必要的计算。目前对所有四个面板(Team 1_Taba、Team 1_Tabb、Team2_Taba、Team2_Tabb)同时运行计算。理想情况下，随着将来添加更多的要素或数据，您可能只想在执行某些操作时运行必要的计算。(即当用户点击Team1_Taba时，只计算需要的表，不需要计算其他页签的表)。模块可以帮助实现这一点。

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

这是你闪亮的应用程序的模块化版本。我在动态UI(renderUI)中使用名称空间(NS(id))时遇到了一些问题，多亏了@YBSWhy the shiny dynamic UI + modules does not give the desired output?的反馈，问题得到了解决，模块化的闪光能够运行。

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

这篇关于闪亮：在选项卡面板之间循环创建表格的更好方法的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！