闪亮的仪表板反应内容问题

Question

我正在尝试自学如何构建闪亮的仪表板并正在尝试反应性内容，但我绝对超出了我的能力范围。我已经为这篇文章简化了我的数据和仪表板。

我的侧边栏菜单项当前如下，但会根据脚本读取的数据文件而有所不同：

• 一般
• 工程
• 分析
• 详细分析

“常规”和“详细分析”侧边栏项目是静态的。其他的则根据读入的数据文件动态确定。我将数据文件读入数据框中，然后查看有哪些部门的数据并生成侧栏菜单。我遇到的问题是当我想在内容页面之一上放置多个绘图/表格等时。我似乎只得到了我尝试显示的最后一个项目。

我的数据如下所示：

Department,FY
Engineering,20
Engineering,24
Engineering,21
Engineering,22
Engineering,23
Engineering,20
Engineering,24
Engineering,22
Analysis,22
Analysis,24
Analysis,20
Analysis,19
Analysis,23

正如我所说，我简化了代码，所以我的输出实际上没有意义。我只是想弄清楚如何在同一页面上呈现两个项目。特别是，我试图在 else 语句中渲染 2 个值框，但我只得到第二个。

这是我的代码：

options(shiny.maxRequestSize = 200*1024^2)

wd <<- choose.dir(caption = "Select top level folder where your data is located")
setwd(wd)

# Read in data
data_df <- read.csv("Work_By_Department.csv")

start_list <- list("General")
end_list <- list("Detailed Analysis")

menu_list <- str_to_title(unique(data_df$Department))
final_menu_list <- c(start_list, menu_list, end_list)

num_items <- length(final_menu_list)
 
print(num_items)

labels = do.call(rbind, Map(data.frame, id = num_items, name = final_menu_list))
labels$tabname <- gsub(" ", "-", labels$name)

ui <- dashboardPage(
  dashboardHeader(title = "Results Dashboard"),
  dashboardSidebar(
    uiOutput("sidebar_menu_UI")
  ),
  
  dashboardBody(
    uiOutput("tabItms")
  ) #dashboardbody
) #dashboardpage

server <- function(input, output, session) {
  
  output$sidebar_menu_UI <- renderUI({
    mytabs <- lapply(1:nrow(labels), function(i) {
      # tabName must correspond to a tabItem tabName
      menuItem(labels$name[i], tabName = labels$tabname[i])
    })
    do.call(function(...) sidebarMenu(id = "mytabs", ...), mytabs)
  })
  
  output$tabItms <- renderUI({
    
    itemsDyn <- lapply(menu_list, function(name) {
      content <- fluidRow(
        h1(
          name,
          style = "font-size:28px; font-family: arial, calibri, sans-serif; text-align: center; margin-left: 15px; margin-top: 5px; text-decoration: underline;"
        ),
        
          if (name == "Engineering") {
            valueBox(
              num_items,
              sprintf("Total Number of %s Efforts", name),
              icon = icon("layer-group", lib="font-awesome"), 
              width = 4
            )
            
          } else {
            valueBox(
              num_items,
              sprintf("Total Number of %s Efforts", name),
              icon = icon("layer-group", lib="font-awesome"), 
              width = 4
            )
            valueBox(
              num_items + 5,
              sprintf("Total Number of %s Efforts", name),
              icon = icon("layer-group", lib="font-awesome"), 
              width = 4
            )
          })

      tabItem(tabName = name, content)
    })
    
    items <- c(
      list(
        tabItem(
          "General",
          fluidRow(
            h1(
              "General Information", 
              style = "font-size:28px; font-family: arial, calibri, sans-serif; text-align: center; margin-left: 15px; margin-top: 5px; text-decoration: underline"
            ),
            valueBox(
              num_reps, 
              "Total Number of Departments", 
              icon = icon("layer-group", lib = "font-awesome"), 
              width = 4
            )
          )
        )
      ),  
      itemsDyn,
      list(
        tabItem(
          tabName = "Detailed-Analysis",
          fluidRow(
            h1(
              "Detailed Analysis", 
              style = "font-size:28px; font-family: arial, calibri, sans-serif; text-align: center; margin-left: 15px; margin-top: 5px; text-decoration: underline"
            ),
            box(
              title = "Statistics", status = "success", solidHeader = TRUE,
              collapsible = TRUE,
              div(
                "Work Efforts by Department", 
                style = "font-size: 15px; font-family: arial, calibri; text-align: center; font-weight: bold"
              ),
              tags$br(),
              align = "center",
              tableOutput("detailsTable")
            )
          )
        )
      )
    )
    do.call(tabItems, items)
  })
  
  output$detailsTable <- renderTable(
    data_df, bordered = TRUE, digits = 1, striped = TRUE
  )
}

# Run the app ----
shinyApp(ui, server)

我将非常感谢任何帮助。谢谢！

Answer 1

使用

tagList

是一种可能的方法：

content <- fluidRow(
  h1(
    name,
    style = "font-size:28px; font-family: arial, calibri, sans-serif; text-align: center; margin-left: 15px; margin-top: 5px; text-decoration: underline;"
  ),
  
  if (name == "Engineering") {
    valueBox(
      num_items,
      sprintf("Total Number of %s Efforts", name),
      icon = icon("layer-group", lib="font-awesome"), 
      width = 4
    )
    
  } else {
    tagList(
      valueBox(
        num_items,
        sprintf("Total Number of %s Efforts", name),
        icon = icon("layer-group", lib="font-awesome"), 
        width = 4
      ),
      valueBox(
        num_items + 5,
        sprintf("Total Number of %s Efforts", name),
        icon = icon("layer-group", lib="font-awesome"), 
        width = 4
      )
    )
  }
  
)