I am trying to teach myself how to build a Shiny Dashboard and am experimenting with reactive content, and I am definitely over my head. I have simplified my data and dashboard for this post.
My sidebar menu items are currently the following, but will vary based upon the data file that the script reads:
The "General" and "Detailed Analysis" sidebar items are static. The others are determined dynamically based upon a data file that is read in. I read the data file into a data frame, and then see which Departments there are data for and generate the side bar menu. The issue that I am having is when I want to put more than one plot / table etc on one of the content pages. I only seem to get the last item that I try to display.
My data 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
As I said, I have simplified the code, so my outputs don't really make sense. I am just trying to figure out how to render 2 items on the same page. In particular, I am trying to render 2 value boxes in the else statement and I only get the second one.
Here is my code:
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)
I would greatly appreciate any help. Thanks!
Using tagList
is a possible way:
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
)
)
}
)