我的仪表板有一个工作版本，没有任何动态内容，但是当尝试改进它并添加一些动态内容时，我遇到了问题。这是我第一次真正尝试添加任何动态内容。我已经为这篇文章简化了我的数据和仪表板。
我的侧边栏菜单项当前为：
“常规”和“详细分析”侧边栏项目是静态的。其他三个（工程、分析和人力资源）目前是静态的，但并不总是有所有这些的数据，所以我想尝试使这些变得动态。我将数据文件读入数据框中，然后查看哪些部门有数据，然后我想根据哪些部门有数据生成侧边栏菜单选项卡。
示例数据文件如下所示：
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
对于此数据文件，没有人力资源部门的条目，因此我希望它不要显示在侧边栏菜单中。我实际上已经完成了该工作，但我不确定如何正确添加与每个侧边栏菜单项相对应的页面内容。在我尝试添加动态内容之前，一切都正常。我想我只是不知道如何正确实现这一点，而且我还没有找到任何关于 Shiny Dashboard 的真正好的参考，所以我正在尝试自学。然而，我已经花了两天时间在这上面，我绝对需要帮助。
这是我的代码：
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 <- c(1:length(final_menu_list))
labels = do.call(rbind, Map(data.frame, id = num_items, name = final_menu_list))
# Get number of efforts per department
department_df <- filter(data_df) %>%
group_by(Department) %>%
tally()
ui <- dashboardPage(
dashboardHeader(title = "Results Dashboard"),
dashboardSidebar(
sidebarMenu(id = "mytabs",
uiOutput("sidebar_menu_UI")
)
),
dashboardBody(
uiOutput("tabItms")
# tabItems(
# # First tab content
# tabItem(tabName = "General",
# fluidRow(
# h1("General Information", style = "font-size:28px; font-family: arial, calibri, san-serif; text-align: center; margin-left: 15px; margin-top: 5px; text-decoration: underline"),
# # A static valueBox
# valueBox(num_reps, "Total Number of Departments", icon = icon("layer-group", lib="font-awesome"), width=4)
# )),
#
# # Second tab content
# tabItem(tabName = "Engineering",
# fluidRow(
# h1("Engineering", style = "font-size:28px; font-family: arial, calibri, san-serif; text-align: center; margin-left: 15px; margin-top: 5px; text-decoration: underline"),
# # A static valueBox
# valueBox(num_reps, "Total Number of Engineering Efforts", icon = icon("layer-group", lib="font-awesome"), width=4)
# )),
#
# # Third tab content
# tabItem(tabName = "Analysis",
# fluidRow(
# h1("Engineering", style = "font-size:28px; font-family: arial, calibri, san-serif; text-align: center; margin-left: 15px; margin-top: 5px; text-decoration: underline"),
# # A static valueBox
# valueBox(num_reps, "Total Number of Analysis Efforts", icon = icon("layer-group", lib="font-awesome"), width=4)
# )),
#
# # Fourth tab content
# tabItem(tabName = "Human Resources",
# fluidRow(
# h1("Human Resources", style = "font-size:28px; font-family: arial, calibri, san-serif; text-align: center; margin-left: 15px; margin-top: 5px; text-decoration: underline"),
# # A static valueBox
# valueBox(num_reps, "Total Number of Human Resource Efforts", icon = icon("layer-group", lib="font-awesome"), width=4)
# )),
#
# # Fifth tab content
# tabItem(tabName = "Detailed Analysis",
# fluidRow(
# h1("Detailed Analysis", style = "font-size:28px; font-family: arial, calibri, san-serif; text-align: center; margin-left: 15px; margin-top: 5px; text-decoration: underline"),
# box(
# title = "Statistics", status = "success", solidHeader = TRUE,
# collapsible = TRUE,
# div("Number of Work Efforts by Department", style = "font-size: 15px; font-family: arial, calibri; text-align: center; font-weight: bold"),
# tags$br(),
# align="center",
# tableOutput("detailsTable")))),
#
# ) #tabitems
) #dashboardbody
) #dashboardpage
server <- function(input, output, session) {
output$sidebar_menu_UI <- renderUI({
mytabs = lapply(1:nrow(labels), function(i){
menuItem(labels$name[i], tabName = labels$id[i])
})
print(mytabs)
do.call(sidebarMenu, mytabs)
})
output$tabItms <- renderUI ({
itemsDyn <- lapply(mytabs, function(name){
tabItem(tabName = name, uiOutput(name))
})
items <- c(
list(
tabItem("General",
fluidRow(
h1("General Information", style = "font-size:28px; font-family: arial, calibri, san-serif; text-align: center; margin-left: 15px; margin-top: 5px; text-decoration: underline"),
# A static valueBox
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, san-serif; text-align: center; margin-left: 15px; margin-top: 5px; text-decoration: underline"),
box(
title = "Statistics", status = "success", solidHeader = TRUE,
collapsible = TRUE,
div("Number of 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(
department_df, bordered = TRUE, digits = 1, striped = TRUE
)
}
# Run the app ----
shinyApp(ui, server)
注释掉的部分是我在尝试添加动态侧边栏菜单之前的工作方式留下的。有人可以提供的任何帮助将不胜感激！
library(shiny)
library(shinydashboard)
start_list <- "General" # don't use list
end_list <- "Detailed Analysis" # idem
menu_list <- stringr::str_to_title(c("aaa", "bbb"))
final_menu_list <- c(start_list, menu_list, end_list)
num_items <- 1:length(final_menu_list)
labels <- do.call(rbind, Map(data.frame, id = num_items, name = final_menu_list))
# the tabNames cannot contain white spaces => we replace them with hyphens
labels$tabname <- gsub(" ", "-", labels$name)
num_reps <- 10 # what is num_reps ??? it is used below
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;"
),
valueBox(
num_reps,
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(
"Number of 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(
iris[1:5, ], bordered = TRUE, digits = 1, striped = TRUE
)
}
# Run the app ----
shinyApp(ui, server)