library(plotly)
library(ggplot2)
library(shiny)
library(shinyWidgets)
library(shinydashboard)
library(leaflet)
library(leaflet.extras)
library(DT)
library(formattable)
library(data.table)
dataset<- read.csv("../2022 Work/ShinyFiles/ipedscensusdata.csv")
mapdata<- read.csv("../2022 Work/ShinyFiles/mapdata.csv")
GradRate<- read.csv("../2022 Work/ShinyFiles/GradRate.csv")
EnrollmentDB<- read.csv("../2022 Work/ShinyFiles/EnrollmentDB.csv")
Demograph<- read.csv("../2022 Work/ShinyFiles/Demograph.csv")
Community<- read.csv("../2022 Work/ShinyFiles/Community.csv")
corrdata<-read.csv("../2022 Work/ShinyFiles/corrdata.csv")
corrdata<- select(corrdata, Institution, State, Community_Type, Type, County, FT_Retention, PT_Retention, TwoYGradRate100,
TwoYGradRate150, TwoYGradRate200, FourYGradRate100, FourYGradRate150, FourYGradRate200, Cost_Off_Campus,
Cost_on_Campus, Percent_Women, Percent_FT, Percent_White, Median_Household_Income, County_Percent_Veteran,
County_Percent_in_Same_House, County_Percent_Never_Married, County_Percent_Married, County_Percent_Divorced,
County_Percent_Separated, County_Percent_Widowed, County_Percent_Single, County_Percent_Less_than_HS, County_Percent_HS,
County_Percent_Some_or_AS, County_Percent_Bach, County_Percent_Grad_or_Pro, County_Percent_Single_Parent,
County_Percent_Not_Citizen, County_Percent_Imigrant, County_Percent_Rent, County_Percent_Unemployed, County_Percent_White)
corrmatrix<- read.csv("../2022 Work/ShinyFiles/corrmatrix2.csv", header = TRUE)
rownames(corrmatrix) <- corrmatrix$variable
Degrees_and_Jobs<- read.csv("../2022 Work/ShinyFiles/Degrees_and_Jobs.csv")
Degrees_and_Jobs<- Degrees_and_Jobs %>%
select(Institution_Name, Select_a_State, Degree_Title, Career_Title, CIPCODE, SOCCODE, Total_Programs, Total_Employed, Mean_Hourly, Mean_Annual, Hourly_Median, Median_Annual)
Career_Projections<- read.csv("../2022 Work/ShinyFiles/Career_Projections.csv")
Career_Projections<- Career_Projections %>%
select(Institution_Name, Select_a_State, Degree_Title, Career_Title,
Employment..2019, Employment..2029, Employment_Change_Number,
Employment_Change_Percent,Average_Anual_Openings, Median_Annual_Wage_2020,
Required_Education, Required_Job_Experience)
datadictionary<-read.csv("../2022 Work/ShinyFiles/DataDictionary.csv")
ui <- dashboardPage(skin = "purple",
dashboardHeader(title = "IPEDS Dashboard (2019 Data)"),
dashboardSidebar(
sidebarMenu(
menuItem("Introduction", tabName = "intro", icon = icon("user")),
menuItem("Institution Map", tabName = "instmap", icon = icon("user")),
menuItem("Historic Enrollment", tabName = "histenroll", icon = icon("user")),
menuItem("Demographics", tabName = "demos", icon = icon("user")),
menuItem("Graduation and Retention", tabName = "ccgraduation", icon = icon("user")),
menuItem("Dynamic Scatterplot", tabName = "correlations", icon = icon("user")),
menuItem("Correlation Coefficients", tabName = "matrix", icon = icon("user")),
menuItem("Degrees and Careers", tabName = "jobs", icon = icon("user")),
menuItem("Degrees and Job Projections", tabName = "projections", icon = icon("user")),
menuItem("Data Dictionary", tabName = "dictionary", icon = icon("user")))),
dashboardBody(
tabItems(
tabItem(tabName = "intro",
img(src = "image.png", height = 180, width = 320),
h1("IPEDS Dashboard", align = "center"),
h2("About this Dashboard"),
h3("This dashboard is still under development, but pulls from the IPEDS data, U.S. Census Bureau data from the same year
and joins them by using county code identifiers. The data are then munged and combined to create a dashboard
of metrics on all IPEDS reporting public higher education institutions in the United States and its territories.
The IPEDS data are the most recently available finalized data; however, I may upload and munge the provisional
data."),
h2("Using the Dashboard"),
h3("The left bar of the dashboard contains several tabs. You are currently on the first tab, 'Introduction'. Click on tabs to maneuver
to different interfaces. Each interface contains filters or search options where you can select one or more variables to adjust the
graph. If you hover above a graph element, you should be able to see information in a tooltip. If you get lost in a bunch of filters,
simply refresh the webpage."),
h2("R Packages"),
h3("The development of this dashboard mainly uses the following packages:", tags$em("tidycensus, ipeds, ggplot2, tidyverse, dplyr"), "and",
tags$em("leaflet."),
"I will publish the RMarkdown on Rpubs when I'm finished. This was quite a data munging project and has over 1300 lines of RMarkdown code."),
h2("Data Sets"),
h3("The buttons below provide you with the complete datasets that were used in this dashboard. In addition, I provide a link to the RPubs pages where I post
my R programming language for querying and munging the data. The first dataset includes everything used in the map, demographic, retention/graduation, and correlation
tab. The next two datasets provide degree and career related datasets.If extracting these data, please cite this paper LINK to COME."),
h3(HTML("<p> If you would like to see the complete programminmg code, the link to the RPubs page
<a href = 'https://rpubs.com/IPEDS'</a>is here.</p>")),
fluidRow(
box(width = 10,
downloadButton("dataset", "Download Institution Data"),
downloadButton("Degrees_and_Jobs", "Download Degree and Job Data"),
downloadButton("Career_Projections", "Download Career Projection Data")
)),
h2("This dashboard will be updated frequently, so expect some changes in interface and additional tabs,
plots and features.")
),
tabItem(tabName = "instmap",
h2("Interactive Map of all IPEDS Reporting Colleges and Universities
in the U.S. and its Territories", align = "center"),
h3("Use the magnifying glass to find your instititution then click on a green or purple circle to get information about it.", align = "center"),
fluidRow(
box(leafletOutput("map", height = 800), width = 1000)),
),
tabItem(tabName = "histenroll",
h3("Use your keyboard to delete or type states and institutions, or use the dropdown options."),
fluidRow(
selectInput("stateInput4", "Select One or More States:",
choices = sort(unique(EnrollmentDB$State)),
selected = "WY", multiple = TRUE),
uiOutput("instInput4")),
fluidRow(
box(plotlyOutput("plot4", height = 500), width = 1000))),
tabItem(tabName = "demos",
h3("Use your keyboard to delete or type states and institutions, or use the dropdown options."),
fluidRow(
selectInput("stateInput5", "Select One or More States:",
choices = sort(unique(Demograph$State)),
selected = "WY", multiple = TRUE),
uiOutput("instInput5")),
fluidRow(
box(plotlyOutput("plot5", height = 500), width = 1000))),
tabItem(tabName = "ccgraduation",
h3("Use your keyboard to delete or type states and institutions, or use the dropdown options."),
fluidRow(
selectInput("stateInput", "Select One or More States:",
choices = sort(unique(GradRate$State)),
selected = "WY", multiple = TRUE),
uiOutput("instInput")),
fluidRow(
box(plotlyOutput("plot", height = 500), width = 1000))),
tabItem(tabName = "correlations",
h3("Correlations between Institutional Factors ( IPEDS) and Community Factors ( U.S. Census)",
align = "center"),
h4("Regression analysis statistics are given below the plot.
Results are derived from all states' combined data, not from individual states.", align = "center"),
fluidRow(
downloadButton("downloadDataplot", "Download the Data Dictionary"),
varSelectInput(
inputId = "xvar",
label = "Select an X variable",
data = Community,
selected = "Percent_Women")),
fluidRow(
varSelectInput(
inputId = "yvar",
label = "Select a Y variable",
data = Community,
selected = "Percent_FT")),
fluidRow(
pickerInput("stateInput6", "Select one or more States:",
choices = sort(unique(Community$State)),
multiple = TRUE,
options = list("actions-box" = TRUE),
selected = Community$State)),
fluidRow(
box(plotlyOutput("plot6", height = 500), width = 1000),
box(verbatimTextOutput("reg")),
box(verbatimTextOutput("reg1")),
box(verbatimTextOutput("reg2")))),
tabItem(tabName = "matrix",
h3("Pearson", tags$em("r"), "Correlations between College/University Variables and County Variables", align = "center"),
h3("United States Cesus Bureau and IPEDS Data, ", align = "center"),
h4("(", tags$em("n"), " = 1634)", align = "center"),
h4(tags$b("You can download the data dictionary and you can select your rows and columns for Pearson r correlation coefficients")),
fluidRow(
downloadButton("downloadData", "Download the Data Dictionary"),
varSelectInput(
inputId = "columnInput",
label = "Select one or more columns:",
data = corrmatrix,
selected = c("PT_Retention", "FT_Retention"),
multiple = TRUE)),
fluidRow(
pickerInput("varInput", "Select one or more rows:",
choices = sort(unique(corrmatrix$variable)),
options = list("actions-box" = TRUE), multiple = TRUE,
selected = corrmatrix$variable)),
fluidRow(
box(width = 10,
DT::dataTableOutput("corrtable")))),
tabItem(tabName = "jobs",
h3("Degree Programs and Careers using IPEDS and U.S. Department of Labor Data ()", align = "center"),
h3("Wage metrics represent national aggregations, not local or state level.", align = "center"),
h4(tags$b("Use the boxes to search. You can type in your search terms to better pinpoint your variables")),
fluidRow(
pickerInput("stateInputd", "Select or type one or more states",
choices = sort(unique(Degrees_and_Jobs$Select_a_State)),
options = list("actions-box" = TRUE),
multiple = TRUE,
selected = "AK")),
fluidRow(
pickerInput("instInputd", "Select or type one or more institutions:",
choices = sort(unique(Degrees_and_Jobs$Institution_Name)),
options = list("actions-box" = TRUE),
multiple = TRUE)),
fluidRow(
pickerInput("degreeInput", "Select or type one or more degrees:",
choices = sort(unique(Degrees_and_Jobs$Degree_Title)),
options = list("actions-box" = TRUE),
multiple = TRUE)),
fluidRow(
box(width = 10,
DT::dataTableOutput("degrees")))),
tabItem(tabName = "projections",
h3("Job Projections given Degrees using IPEDS and U.S. Department of Labor Data ()", align = "center"),
h3("Wage metrics represent national aggregations, not local or state level. Numbers are in the thousands", align = "center"),
h4(tags$b("Use the boxes to search. You can type in your search terms to better pinpoint your variables")),
fluidRow(
pickerInput("stateInputd2", "Select or type one or more states",
choices = sort(unique(Career_Projections$Select_a_State)),
options = list("actions-box" = TRUE),
multiple = TRUE,
selected = "AK")),
fluidRow(
pickerInput("instInputd2", "Select or type one or more institutions:",
choices = sort(unique(Career_Projections$Institution_Name)),
options = list("actions-box" = TRUE),
multiple = TRUE)),
fluidRow(
pickerInput("degreeInput2", "Select or type one or more degrees:",
choices = sort(unique(Career_Projections$Degree_Title)),
options = list("actions-box" = TRUE),
multiple = TRUE)),
fluidRow(
box(width = 10,
DT::dataTableOutput("projections")))),
tabItem(tabName = "dictionary",
h1("Variables, Sources, and Descriptions of the Variables", align = "center"),
fluidRow(
box(width = 10,
DT::dataTableOutput("dictionarytable"))))
)))
server <- function(input, output, session) {
##### Community College Degrees
df0 <- eventReactive(input$stateInput, {
GradRate %>% filter(State %in% input$stateInput)
})
output$instInput <- renderUI({
selectInput("instInput", "Next Select One or More Colleges:", sort(unique(df0()$Institution)), selected = "Casper College", multiple = TRUE)
})
df1 <- eventReactive(input$instInput, {
df0() %>% filter(Institution %in% input$instInput)
})
####Historical Enrollment
df6 <- eventReactive(input$stateInput4, {
EnrollmentDB %>% filter(State %in% input$stateInput4)
})
output$instInput4 <- renderUI({
selectInput("instInput4", "Next Select One or More Colleges:", sort(unique(df6()$Institution)),
selected = "Casper College", multiple = TRUE)
})
df7 <- eventReactive(input$instInput4, {
df6() %>% filter(Institution %in% input$instInput4)
})
#####Demographics
df8 <- eventReactive(input$stateInput5, {
Demograph %>% filter(State %in% input$stateInput5)
})
output$instInput5 <- renderUI({
selectInput("instInput5", "Next Select One or More Colleges:", sort(unique(df8()$Institution)),
selected = "Casper College", multiple = TRUE)
})
df9 <- eventReactive(input$instInput5, {
df8() %>% filter(Institution %in% input$instInput5)
})
####Demographics
ab <- reactive({
Community %>%
filter(State %in% input$stateInput6)
})
#######Correlation Table Inputs
varfilter <- reactive({
filtered <- corrmatrix %>%
filter(variable %in% input$varInput)
})
#######
model <- eventReactive(c(input$xvar, input$yvar), {
req(c(input$xvar, input$yvar))
lm(as.formula(paste(input$yvar, collapse = " + ", " ~ ", paste(input$xvar, collapse = " + "))), data = ab())
})
#####Degrees and Careers
state_deg <- reactive({
filter(Degrees_and_Jobs, Select_a_State %in% input$stateInputd)
})
observeEvent(state_deg(), {
choices <- sort(unique(state_deg()$Institution_Name))
updatePickerInput(session = session, inputId = "instInputd", choices = choices, selected = Degrees_and_Jobs$Institution_Name)
})
institution_deg <- reactive({
req(input$instInputd)
filter(state_deg(), Institution_Name %in% input$instInputd)
})
observeEvent(institution_deg(), {
choices <- sort(unique(institution_deg()$Degree_Title))
updatePickerInput(session = session, inputId = "degreeInput", choices = choices, selected = Degrees_and_Jobs$Degree_Title)
})
####Job Projections
state_deg2 <- reactive({
filter(Career_Projections, Select_a_State %in% input$stateInputd2)
})
observeEvent(state_deg2(), {
choices <- sort(unique(state_deg2()$Institution_Name))
updatePickerInput(session = session, inputId = "instInputd2", choices = choices, selected = Career_Projections$Institution_Name)
})
institution_deg2 <- reactive({
req(input$instInputd2)
filter(state_deg2(), Institution_Name %in% input$instInputd2)
})
observeEvent(institution_deg2(), {
choices <- sort(unique(institution_deg2()$Degree_Title))
updatePickerInput(session = session, inputId = "degreeInput2", choices = choices, selected = Career_Projections$Degree_Title)
})
########################Welcome Page##############
output$dataset <- downloadHandler(
filename = function() {
paste("dataset", ".csv", sep = "")
},
content = function(file) {
write.csv(dataset, file)
}
)
output$Degrees_and_Jobs <- downloadHandler(
filename = function() {
paste("Degrees_and_Jobs", ".csv", sep = "")
},
content = function(file) {
write.csv(Degrees_and_Jobs, file)
}
)
output$ Career_Projections <- downloadHandler(
filename = function() {
paste("Career_Projections ", ".csv", sep = "")
},
content = function(file) {
write.csv(Career_Projections, file)
}
)
#################################################################################################
#####Institution Map
output$map <- renderLeaflet({
pal <- colorFactor(palette = c("green4", "purple"), domain = mapdata$Type)
m <-
leaflet(mapdata) %>%
addTiles() %>%
addSearchOSM(options = searchOptions(zoom = 9, collapsed = TRUE, hideMarkerOnCollapse = TRUE)) %>%
addCircleMarkers(group = "name", color = ~pal(mapdata$Type), fillOpacity = .8, lng = mapdata$Longitude, lat = mapdata$Lattitude,
popup =
paste0("Name:", "\n", mapdata$Institution,
"<br/>", "State:", "\n", mapdata$State,
"<br/>", "Fall Enrollment:", "\n", comma(mapdata$Tot_Enrolled, digits = 0),
"<br/>", "Cost off Campus:", "\n", paste0("$", comma(mapdata$Cost_Off_Campus, digits = 0)),
"<br/>", "Bachelor Grad Rate:", "\n", mapdata$FourYGradRate150 %>% paste0("%"),
"<br/>", "Associate/Cert Grad Rate:", "\n", mapdata$TwoYGradRate150 %>% paste0("%"))) %>%
addLegend("bottomright", pal = pal, values = ~mapdata$Type, title = "College Type", opacity = 1) %>% setView(
lng = -98, lat = 38.87216, zoom = 3) %>% addResetMapButton()
m
})
#####Make Enrollment Plot
output$plot4 <- renderPlotly({
enroll <-
ggplot(df7(), aes(x = factor(Year), y = Enrollment, group = Institution, color = Institution, text = paste("Institution:", Institution, "<br />State:",
State, "<br />Year:", Year, "<br />Enrollment Total:", Enrollment))) +
geom_line(stat = "summary", fun = "mean") +
geom_point(stat = "summary", fun = "mean") +
ggtitle("Historical Fall Enrollment") +
xlab("") +
ylab("Enrollment") +
scale_color_brewer(palette = "Dark2") +
theme(axis.text.x = element_text(angle = 45))
ggplotly(enroll, tooltip = "text")
})
######Make demographic Plot
output$plot5 <- renderPlotly({
demo <- ggplot(df9(), aes(x = Demographic, y = Percent, group = Institution, fill = Institution,
text = paste("Institution:", Institution, "<br />State:", State, "<br />Demographic:", Demographic,
"<br />Percent:", Percent %>% paste0("%")))) +
geom_bar(stat = "summary", fun = "mean", position = "dodge2") +
ggtitle("Demographics") +
xlab("") +
ylab("Percent") +
scale_y_continuous(labels = function(x) paste0(x, "%")) +
scale_fill_brewer(palette = "Dark2") +
coord_flip() +
theme(axis.text.x = element_text(angle = 45))
ggplotly(demo, tooltip = "text")
})
####Make CC Plot
output$plot <- renderPlotly({
grad <- ggplot(df1(), aes(x = RateLevel, y = Rate, group = Institution, fill = Institution,
text = paste("Institution:", Institution, "<br />State:", State, "<br />Rate Level:",
RateLevel, "<br />GraduationRate:", Rate %>% paste0("%")))) +
geom_bar(stat = "summary", fun = "mean", position = "dodge2") +
ggtitle("Graduation and Retention Rates") +
xlab("") +
ylab("Rate") +
scale_y_continuous(labels = function(x) paste0(x, "%")) +
scale_fill_brewer(palette = "Dark2") +
coord_flip() +
theme(axis.text.x = element_text(angle = 45))
ggplotly(grad, tooltip = "text")
})
###Make Correlation Plot
output$downloadDataplot <- downloadHandler(
filename = function() {
paste("Data_Dictionary", ".csv", sep = "")
},
content = function(file) {
write.csv(datadictionary, file)
}
)
output$plot6 <- renderPlotly({
com <- ggplot(ab(), aes_string(x = input$xvar, y = input$yvar)) +
geom_point(aes(color = Community_Type, label3 = State, label4 = County, label5 = Institution)) +
geom_smooth(method = "lm") +
theme(axis.text.x = element_text(angle = 45)) +
scale_color_discrete(name = " ")
ggplotly(com)
})
output$reg <- renderPrint({
coef(summary(model()))
})
output$reg1 <- renderPrint({
print(paste("R-Squared = ", summary(model())$r.squared))
})
output$reg2 <- renderPrint({
print(paste("Adjusted R-Squared = ", summary(model())$adj.r.squared))
})
####Post Table of Correlations
brks <- seq(-1, 1, .01)
clrs <- colorRampPalette(c("white", "#6baed6"))(length(brks) + 1)
dataCol_df <- ncol(corrmatrix) - 1
dataColRng <- 1:dataCol_df
output$downloadData <- downloadHandler(
filename = function() {
paste("Data_Dictionary", ".csv", sep = "")
},
content = function(file) {
write.csv(datadictionary, file)
}
)
output$corrtable <- DT::renderDataTable(datatable({
if (length(input$columnInput) == 0) return(varfilter())
varfilter() %>%
dplyr::select(!!!input$columnInput)
}, rownames = TRUE, extensions = "FixedColumns",
options = list(paging = TRUE, searching = FALSE, info = FALSE,
sort = TRUE, scrollX = TRUE, fixedColumns = list(leftColumns = 2))) %>%
formatStyle(columns = dataColRng, backgroundColor = styleInterval(brks, clrs)))
####Post table of CIPs and SOCs
output$degrees <- DT::renderDataTable(options = list(autoWidth = TRUE, scrollX = TRUE, searching = FALSE), {
req(input$degreeInput)
institution_deg() %>%
filter(Degree_Title %in% input$degreeInput) %>%
select(Institution_Name, Degree_Title, Career_Title, Mean_Hourly, Mean_Annual, Hourly_Median, Median_Annual)
})
###Post table of degrees and job projections
output$projections <- DT::renderDataTable(options = list(autoWidth = TRUE, scrollX = TRUE, searching = FALSE), {
req(input$degreeInput2)
institution_deg2() %>%
filter(Degree_Title %in% input$degreeInput2) %>%
select(Institution_Name, Select_a_State, Degree_Title, Career_Title,
Employment..2019, Employment..2029, Employment_Change_Number,
Employment_Change_Percent, Average_Anual_Openings, Median_Annual_Wage_2020,
Required_Education, Required_Job_Experience)
})
#### Post data dictionary table
output$dictionarytable <- DT::renderDataTable(
datadictionary,
options = list(scrollX = TRUE))
}
shinyApp(ui = ui, server = server)
Shiny applications not supported in static R Markdown documents