Hope this reprex is 'minimal' enough! I really tried to pare it down as much as possible...
My shiny app below works great! No problems except if the user selects options that filter out ALL of the data (i.e. selecting an undergraduate degree but viewing the graduate tab) the table shows an error. "Error: undefined columns selected
"
I am trying to figure out the best way to handle this. My thought is that the best way is to show a message that says something like, "No data matches your filters" instead of trying to code different menus for each tab and each possible scenario, but I can't for the life of me figure out how to do this. I swear I have tried searching google, stack overflow, and RStudio Community and can't seem to get anything to work!
Any feedback on my code and best practices is also appreciated. I am pretty new to all this and there's probably more efficient ways of doing this...
############### LOAD PACKAGES #################################################
library(shiny)
library(shinythemes)
library(dplyr)
library(tidyr)
library(DT)
############### LOAD DATA ####################################################
df <- structure(list(Year = c(rep(2017L, 93), rep(2018L, 90)),
Semester = c(rep("Fall", 45), rep("Spring", 48),
rep("Fall", 44), rep("Spring", 46)),
College_Type = c(rep("Community", 18), rep("Senior", 27),
rep("Community", 18), rep("Senior", 30),
rep("Community", 18), rep("Senior", 26),
rep("Community", 18), rep("Senior", 28)),
College = c(rep("BMCC", 6), rep("Bronx", 6), rep("Hostos", 6),
rep("Baruch", 9), rep("Staten Island", 12), rep("York", 6),
rep("BMCC", 6), rep("Bronx", 6), rep("Hostos", 6),
rep("Baruch", 10), rep("Staten Island", 13),
rep("York", 7), rep("BMCC", 6), rep("Bronx", 6), rep("Hostos", 6),
rep("Baruch", 8), rep("Staten Island", 12), rep("York", 6),
rep("BMCC", 6), rep("Bronx", 6), rep("Hostos", 6), rep("Baruch", 9),
rep("Staten Island", 13), rep("York", 6)),
Class_Level = c(rep("UNDERGRADUATE", 18), rep("GRADUATE", 5),
rep("UNDERGRADUATE", 4), rep("GRADUATE", 6),
rep("UNDERGRADUATE", 6), rep("GRADUATE", 2),
rep("UNDERGRADUATE", 22), rep("GRADUATE", 6),
rep("UNDERGRADUATE", 4), rep("GRADUATE", 6),
rep("UNDERGRADUATE", 7), rep("GRADUATE", 3),
rep("UNDERGRADUATE", 22), rep("GRADUATE", 4),
rep("UNDERGRADUATE", 4), rep("GRADUATE", 6),
rep("UNDERGRADUATE", 6), rep("GRADUATE", 2),
rep("UNDERGRADUATE", 22), rep("GRADUATE", 5),
rep("UNDERGRADUATE", 4), rep("GRADUATE", 7),
rep("UNDERGRADUATE", 6), rep("GRADUATE", 2),
rep("UNDERGRADUATE", 4)),
Enrollment_Status = c(rep(c(rep("FULL-TIME",3),rep("PART-TIME",3)),3),
rep("FULL-TIME",2), rep("PART-TIME",3),
rep("FULL-TIME",2), rep("PART-TIME",2),
rep("FULL-TIME",2), rep("PART-TIME",4),
rep("FULL-TIME",3), rep("PART-TIME",3),
"FULL-TIME", "PART-TIME", rep("FULL-TIME",2),
"PART-TIME", "PART-TIME",
rep(c(rep("FULL-TIME",3),rep("PART-TIME",3)),4),
rep("FULL-TIME",2), rep("PART-TIME",2),
rep("FULL-TIME",2), rep("PART-TIME",4),
rep("FULL-TIME",4), rep("PART-TIME",3),
"FULL-TIME", rep("PART-TIME",2),
rep("FULL-TIME",2), rep("PART-TIME",2),
rep(c(rep("FULL-TIME",3),rep("PART-TIME",3)),3),
rep(c(rep("FULL-TIME",2),rep("PART-TIME",2)),3),
rep("PART-TIME",2), "FULL-TIME",
rep("FULL-TIME",2), rep("PART-TIME",3),
"FULL-TIME", "PART-TIME",
rep("FULL-TIME",2), rep("PART-TIME",2),
rep(c(rep("FULL-TIME",3),rep("PART-TIME",3)),3),
rep("FULL-TIME",2), rep("PART-TIME",3),
rep("FULL-TIME",2), rep("PART-TIME",2),
rep("FULL-TIME",3), rep("PART-TIME",4),
rep("FULL-TIME",3), rep("PART-TIME",3),
"FULL-TIME", "PART-TIME",
rep("FULL-TIME",2), rep("PART-TIME",2)),
Degree_Pursued_Level = c(rep(c("ASSOCIATE", "CERTIFICATE", "NONDEGREE"),6),
"MASTER'S", "NONDEGREE", "ADVANCED CERTIFICATE",
"MASTER'S", "NONDEGREE", rep(c("BACHELOR'S", "NONDEGREE"),2),
"DOCTORAL", "MASTER'S", "ADVANCED CERTIFICATE",
"DOCTORAL", "MASTER'S", "NONDEGREE",
rep(c("ASSOCIATE", "BACHELOR'S", "NONDEGREE"),2),
rep("MASTER'S",2), rep(c("BACHELOR'S", "NONDEGREE"),2),
rep(c("ASSOCIATE", "CERTIFICATE", "NONDEGREE"),6),
rep(c("ADVANCED CERTIFICATE", "MASTER'S", "NONDEGREE"),2),
rep(c("BACHELOR'S", "NONDEGREE"),2),
"DOCTORAL", "MASTER'S", "ADVANCED CERTIFICATE",
"DOCTORAL", "MASTER'S", "NONDEGREE",
"ASSOCIATE", "BACHELOR'S", "CERTIFICATE", "NONDEGREE",
"ASSOCIATE", "BACHELOR'S", "NONDEGREE",
rep("MASTER'S",2), "NONDEGREE",
rep(c("BACHELOR'S", "NONDEGREE"),2),
rep(c("ASSOCIATE", "CERTIFICATE", "NONDEGREE"),6),
rep(c("MASTER'S", "NONDEGREE"),2),
rep(c("BACHELOR'S", "NONDEGREE"),2),
"DOCTORAL", "MASTER'S", "ADVANCED CERTIFICATE",
"DOCTORAL", "MASTER'S", "NONDEGREE",
rep(c("ASSOCIATE", "BACHELOR'S", "NONDEGREE"),2),
rep("MASTER'S",2), rep(c("BACHELOR'S", "NONDEGREE"),2),
rep(c("ASSOCIATE", "CERTIFICATE", "NONDEGREE"),6),
"MASTER'S", "NONDEGREE", "ADVANCED CERTIFICATE", "MASTER'S",
"NONDEGREE", rep(c("BACHELOR'S", "NONDEGREE"),2),
rep(c("ADVANCED CERTIFICATE", "DOCTORAL", "MASTER'S"),2),
"NONDEGREE", rep(c("ASSOCIATE", "BACHELOR'S", "NONDEGREE"),2),
rep("MASTER'S",2), rep(c("BACHELOR'S", "NONDEGREE"),2)),
SUM.HST.HEADCOUNT. = c(18404,
4, 71, 7017, 32, 1404, 7087, 57, 2, 2935, 91, 763, 4073, 19,
73, 2385, 63, 598, 615, 18, 19, 2372, 12, 11541, 57, 3362, 293,
59, 142, 62, 3, 674, 145, 4125, 5571, 14, 1129, 1293, 377, 126,
14, 4976, 80, 2082, 1255, 16621, 5, 54, 7234, 33, 1405, 6443,
49, 3, 3227, 97, 1001, 3784, 26, 45, 2358, 65, 701, 3, 577, 3,
51, 2322, 6, 10760, 38, 3859, 326, 41, 107, 45, 19, 645, 129,
3311, 5170, 1, 7, 1190, 1600, 360, 56, 37, 0, 4366, 52, 2239,
1260, 18011, 5, 60, 7014, 33, 1383, 6637, 44, 4, 2778, 74, 982,
4041, 22, 75, 2441, 59, 693, 527, 39, 2433, 6, 11442, 53, 3187,
342, 60, 166, 59, 7, 629, 115, 3978, 5566, 23, 1003, 1268, 373,
147, 51, 5003, 82, 2123, 1287, 16510, 4, 69, 6614, 35, 1604,
6395, 42, 5, 2976, 93, 965, 3842, 22, 41, 2324, 55, 604, 606,
4, 3, 2308, 11, 11051, 71, 3610, 357, 1, 39, 133, 41, 30, 653,
120, 3525, 5141, 11, 1117, 1341, 376, 54, 75, 4627, 59, 2075,
1215)),
row.names = c(NA, -183L), class = "data.frame")
############### DATA CLEANING AND PREP #######################################
# Create Sorted Lists for dropdown menus
college <- df[, c("College")] %>% unique() %>% sort() %>% append("All")
year <- df[, c("Year")] %>% unique() %>% sort()
semester <- df[, c("Semester")] %>% unique() %>% sort()
college_type <- df[, c("College_Type")] %>% unique() %>% sort() %>% append("All")
class_level <- df[, c("Class_Level")] %>% unique() %>% sort() %>% append("All")
enrollment_status <- df[, c('Enrollment_Status')] %>% unique() %>% sort() %>% append("All")
degree_pursued <- df[, c('Degree_Pursued_Level')] %>% unique() %>% sort() %>% append("All")
breakdown_options <- names(df)[c(6,7)]
############### USER INTERFACE ###############################################
ui <- fluidPage(
#themeSelector(),
theme = shinytheme("flatly"),
titlePanel('CUNY Enrollment Tables'),
navbarPage("CUNY",
# <<<<<<<<<<<<<<<<<<<<<<< Enrollment Tables >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
tabPanel("Data Tables",
sidebarPanel(
h3('Table Options'),
selectInput('breakdown', 'Select a Breakdown',
breakdown_options, selected='Degree_Status'),
h4('Optional Filters'),
selectInput('year', 'Year',
year, selected=max(year)),
selectInput('semester', 'Semester',
semester, selected='Spring'),
selectInput('college_type', 'College_Type',
college_type, selected='All'),
selectInput('enrollment_status', 'Enrollment_Status',
enrollment_status, selected='All'),
selectInput('degree_pursued', 'Degree_Pursued_Level',
degree_pursued, selected='All'),
hr(),
br()
),
mainPanel(
tabsetPanel(
tabPanel('University Totals',
br(),
dataTableOutput('university_table1')
),
tabPanel('Undergraduate',
br(),
dataTableOutput('undergrad_table1')
),
tabPanel('Graduate',
br(),
dataTableOutput('graduate_table1')
),
id='DataTab'
)
)
)
)
)
############### SERVER #######################################################
server <- function(input, output) {
# <<<<<<<<<<<<<<<<<<<<<<< Reactive Data Prep >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
# <<<<<<<< Set up selections for "All" vs selected values in filters >>>>>>>>>
college_type_select <- reactive(
if (input$college_type == "All") {
head(college_type, n=-1)
} else {input$college_type})
enrollment_status_select <- reactive(
if (input$enrollment_status == "All") {
head(enrollment_status, n=-1)
} else {input$enrollment_status})
degree_pursued_select <- reactive(
if (input$degree_pursued == "All") {
head(degree_pursued, n=-1)
} else {input$degree_pursued})
# <<<<<<<<<<<< Filter out unnecessary rows for Data Tables Tab >>>>>>>>>>>>>>>>
selection1 <- reactive({
df %>%
filter( Year==input$year &
Semester==input$semester &
College_Type %in% college_type_select() &
Enrollment_Status %in% enrollment_status_select() &
Degree_Pursued_Level %in% degree_pursued_select())
})
university_data1 <- reactive({
selection1() %>%
group_by(College, .data[[input$breakdown]]) %>%
summarise(Total=sum(SUM.HST.HEADCOUNT., na.rm=TRUE)) %>%
spread(.data[[input$breakdown]], Total, fill=0) %>%
as.data.frame() %>%
mutate(TOTAL = rowSums(.[3:ncol(.)], na.rm=TRUE))
})
undergrad_data1 <- reactive({
selection1() %>%
filter( Class_Level=="UNDERGRADUATE") %>%
group_by(College, .data[[input$breakdown]]) %>%
summarise(Total=sum(SUM.HST.HEADCOUNT., na.rm=TRUE)) %>%
spread(.data[[input$breakdown]], Total, fill=0) %>%
as.data.frame() %>%
mutate(TOTAL = rowSums(.[3:ncol(.)], na.rm=TRUE))
})
graduate_data1 <- reactive({
selection1() %>%
filter( Class_Level=="GRADUATE") %>%
group_by(College, .data[[input$breakdown]]) %>%
summarise(Total=sum(SUM.HST.HEADCOUNT., na.rm=TRUE)) %>%
spread(.data[[input$breakdown]], Total, fill=0) %>%
as.data.frame() %>%
mutate(TOTAL = rowSums(.[3:ncol(.)], na.rm=TRUE))
})
# <<<<<<<<<<<<<<<<<<<<<<<<<<<< OUTPUTS >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
# <<<<<<<<<<<<<<<< Enrollment University-wide Totals >>>>>>>>>>>>>>>>>>>>>>>>>
output$university_table1 <-
DT::renderDT(datatable(university_data1(),
class = 'stripe hover compact table-condensed',
rownames = FALSE,
filter = 'top',
extensions = 'Buttons',
options = list(dom = 'trBi',
buttons = c('copy', 'csv', 'excel', 'pdf', 'print'),
pageLength = 50)) %>%
formatCurrency(c(2:10),currency = "", interval = 3, mark = ",", digits = 0))
# <<<<<<<<<<<<<<<< Enrollment Undergraduate Tab >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
output$undergrad_table1 <-
DT::renderDT(datatable(undergrad_data1(),
class = 'stripe hover compact table-condensed',
rownames = FALSE,
filter = 'top',
extensions = 'Buttons',
options = list(dom = 'trBi',
buttons = c('copy', 'csv', 'excel', 'pdf', 'print'),
pageLength = 50)) %>%
formatCurrency(c(2:10),currency = "", interval = 3, mark = ",", digits = 0))
# <<<<<<<<<<<<<<<< Enrollment Graduate Tab >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
output$graduate_table1 <-
DT::renderDT(datatable(graduate_data1(),
class = 'stripe hover compact table-condensed',
rownames = FALSE,
filter = 'top',
extensions = 'Buttons',
options = list(dom = 'trBi',
buttons = c('copy', 'csv', 'excel', 'pdf', 'print'),
pageLength = 50)) %>%
formatCurrency(c(2:10),currency = "", interval = 3, mark = ",", digits = 0))
}
############### APP!!! #######################################################
shinyApp(ui = ui, server = server)
Here's a example of what happens when you filter for only doctoral degrees but view it on the undergraduate tab...