I have a working version of my dashboard without any dynamic content, but when trying to improve upon it and add some dynamic content, I am running into issues. This is my first real attempt to add any dynamic content. I have simplified my data and dashboard for this post.
My sidebar menu items are currently:
The "General" and "Detailed Analysis" sidebar items are static. The other three (Engineering, Analysis and Human Resources) are currently static, but there is not always data for all of these, so I wanted to try to make those dynamic. I read a data file into a data frame, and then see which Departments there are data for and then I would like to generate the sidebar menu tabs based upon which departments have data.
An example data file looks like this:
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
For this data file, there are no entries for the Human Resources department, so I would like for it not to show up in the sidebar menu. I actually have that piece working, but I am not sure how to then properly add the page content that corresponds to each of the sidebar menu items. It was all working before I tried to add the dynamic content. I think I just don't know how to properly implement this and I have not found any really good references for Shiny Dashboard, so I am trying to teach myself. However, I have spent two days on this and I am definitely in need of help.
Here is my code:
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)
The commented out sections are left from how I had it working before trying to add the dynamic sidebar menu. Any help that someone can provide would be greatly appreciated!
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)