knitr::opts_chunk$set(echo = TRUE)
Data Munge
library(readxl)
library(openxlsx)
library(tidyverse)
library(dplyr)
library(knitr)
library(shiny)
library(shinyWidgets)
library(DT)
library(formattable)
library(data.table)
library(shinydashboard)
### Read the CC Data file
CC<- read.csv("CCData2.csv")
CC$CIP<- as.character(CC$CIP)
U_Count<- read.csv("Ucount.csv")
U_Count$CIP<- as.character(U_Count$CIP)
All_University<- bind_rows(CC, U_Count)
### Read cost of living data
col<- read_excel('COL_Index.xlsx')%>%
select(Area_Name, Index)
col$Index<- col$Index/100
### Read wage data
wage<- read_excel('StateWage.xlsx')%>%
rename("SOC" = "OCC_CODE")%>%
mutate(StateSoc = paste(AREA_TITLE,SOC))
wage$H_MEAN<- as.numeric(wage$H_MEAN)
wage$A_MEAN<- as.numeric(wage$A_MEAN)
wage$A_MEAN<- as.numeric(wage$A_MEDIAN)
wage$H_MEDIAN<- as.numeric(wage$H_MEDIAN)
### Read CIP SOC Crosswalk
cipsoc<- read.delim("CIP_SOC.txt")%>%
select(-c("CIP2020Title"))
cipsoc$CIP2020Code<- as.character(cipsoc$CIP2020Code)
cipsoc<- cipsoc%>%
rename("CIP" = "CIP2020Code")%>%
rename("SOC" = "SOC2018Code")%>%
rename("Career_Title" = "SOC2018Title")
### Read projections data file
projections<- read.csv("ltprojections.csv")%>%
select(-"stfips")%>%
rename("SOC" = "code")
### Code an Academic Year Variable
All_University<- All_University%>%
subset(TermCode %in% c("16/FA", "17/SP", "17/SU", "17/FA", "18/SP", "18/SU", "18/FA", "19/SP", "19/SU", "19/FA", "20/SP", "20/SU", "20/FA", "21/SP", "21/SU", "21/FA", "22/SP", "22/SU")) %>%
mutate(Year = case_when(
TermCode == "16/FA" ~ "2016-17",
TermCode == "17/SP" ~ "2016-17",
TermCode == "17/SU" ~ "2016-17",
TermCode == "17/FA" ~ "2017-18",
TermCode == "18/SP" ~ "2017-18",
TermCode == "18/SU" ~ "2017-18",
TermCode == "18/FA" ~ "2018-19",
TermCode == "19/SP" ~ "2018-19",
TermCode == "19/SU" ~ "2018-19",
TermCode == "19/FA" ~ "2019-20",
TermCode == "20/SP" ~ "2019-20",
TermCode == "20/SU" ~ "2019-20",
TermCode == "20/FA" ~ "2020-21",
TermCode == "21/SP" ~ "2020-21",
TermCode == "21/SU" ~ "2020-21",
TermCode == "21/FA" ~ "2021-22",
TermCode == "22/SP" ~ "2021-22",
TermCode == "22/SU" ~ "2021-22"))
## Simplify7 file to these variables
All_University<- select(All_University, Institution, TermCode, Year, DegreeType, PROGRAM_DESC, CIP, NumberOfGraduates)
## Spread/pivot the data so each term is a different row
ByTerm<- select(All_University, Institution, TermCode,DegreeType, PROGRAM_DESC, CIP, NumberOfGraduates)
ByTerm<- spread(ByTerm, key=TermCode, value = NumberOfGraduates)
## Re-order the data set
ByTerm<- ByTerm %>%
select(Institution, DegreeType, PROGRAM_DESC, CIP, "16/FA", "17/SP", "17/SU", "17/FA", "18/SP", "18/SU", "18/FA", "19/SP", "19/SU", "19/FA", "20/SP", "20/SU", "20/FA", "21/SP", "21/SU", "21/FA", "22/SP", "22/SU")
### Calculate cusom Sum Variables
ByTerm<- ByTerm %>%
replace(is.na(.), 0)
ByTerm<- ByTerm %>%
mutate("Total_16_17" = rowSums(across(5:7))) %>%
mutate("Total_17_18" = rowSums(across(8:10))) %>%
mutate("Total_18_19" = rowSums(across(11:13))) %>%
mutate("Total_19_20" = rowSums(across(14:16))) %>%
mutate("Total_20_21" = rowSums(across(17:19))) %>%
mutate("Total_21_22"= rowSums(across(20:22))) %>%
mutate("Grand_Tot" = rowSums(across(5:22)))
dashdata<- left_join(cipsoc, projections, by = "SOC")
dashdata<- inner_join(ByTerm, dashdata, by = "CIP")%>%
rename("Program" = "PROGRAM_DESC")%>%
rename("Area_Name" = "areaname")%>%
mutate(StateSoc = paste(Area_Name,SOC))
FullCareer<- left_join(dashdata, wage, by = "StateSoc")%>%
rename("Area Name" = "Area_Name")%>%
rename("Occupation Name" = "Career_Title")%>%
rename("Percent Change" = "percentchange")%>%
rename("Average Annual Openings" = "avgannualopenings")%>%
rename("Projection" = "proj")%>%
rename("Base" = "base")%>%
rename("Change" = "change")%>%
select(Institution, Program, CIP, Total_16_17, Total_17_18, Total_18_19, Total_19_20, Total_20_21, Total_21_22, Grand_Tot, "Area Name", "Occupation Name", Base, Projection, Change, "Percent Change", "Average Annual Openings", H_MEAN, A_MEAN, H_MEDIAN, A_MEDIAN)
FullCareer<- FullCareer %>%
rename("Area_Name" = "Area Name") %>%
rename("Occupation.Name" = "Occupation Name") %>%
rename("2018_Base" = Base) %>%
rename("2028_Base" = Projection) %>%
rename("Percent.Change" = "Percent Change") %>%
rename("Average.Annual.Openings" = "Average Annual Openings") %>%
rename("Hourly_Average_Wage" = H_MEAN) %>%
rename("Annual_Average_Wage" = A_MEAN) %>%
rename("Hourly_Median_Wage" = H_MEDIAN) %>%
rename("Annual_Median_Wage" = A_MEDIAN)
FullCareer<- left_join(FullCareer, col, by = "Area_Name") %>%
mutate ("Hourly_Adjusted_Mean" = Hourly_Average_Wage/Index) %>%
mutate ("Annual_Adjusted_Mean" = Annual_Average_Wage/Index) %>%
mutate ("Hourly_Adjusted_Median" = Hourly_Median_Wage/Index) %>%
mutate ("Annual_Adjusted_Median" = Annual_Median_Wage/Index)
dashdata<- FullCareer
write.csv(dashdata, "../Data/Application/dashdata.csv")
write.csv(dashdata, "dashdata.csv")
Shiny Application Data
library(tidyverse)
library(dplyr)
library(knitr)
library(shiny)
library(shinyWidgets)
library(DT)
library(formattable)
library(data.table)
library(shinydashboard)
library(zip)
###Download Data
zipfile<- zip("zipfile.zip", file = "StateWage.zip")
Table1<- read.csv("dashdata.csv")
Table1<- Table1[!Table1$Area_Name == "United_States",]
Table1<- Table1 %>%
select(Institution, Program, CIP, Area_Name, Occupation.Name, Total_16_17, Total_17_18, Total_18_19, Total_19_20, Total_20_21, Total_21_22, Grand_Tot, X2018_Base, X2028_Base, Change, Percent.Change, Average.Annual.Openings,
Hourly_Adjusted_Median, Annual_Adjusted_Median, Index)%>%
mutate(across(where(is.numeric), ~ round(., digits = 2)))%>%
rename("2018_Base" = X2018_Base)%>%
rename("2028_Base" = X2028_Base)
Table1$Percent.Change<- Table1$Percent.Change/100
datadictionary<- read.csv("Data.csv")
###User interface
ui <-
dashboardPage(skin = "green",
dashboardHeader(title = "Degrees and Careers"),
dashboardSidebar(
sidebarMenu(
menuItem("Introduction", tabName = "intro", icon = icon("user")),
menuItem("Data Table", tabName = 'datatable', icon = icon("user")),
menuItem("Data Dictionary", tabName = "dictionary", icon = icon("user")),
menuItem("Sources", tabName = "references", icon = icon("user")))),
dashboardBody(
tabItems(
tabItem(tabName = "intro",
fluidPage(setBackgroundImage(src = "tree.png", shinydashboard = TRUE)),
h1("About this Dashboard", align = "left", style = "color: white"),
h2("The purpose of this dashboard is to allow the user to connect any higher education degree
affiliated with a Classification of Instructional Program (CIP) code to a career associated with that CIP code to
investigate ten-year job growth projections by any U.S. state, and to examine wage information about that
affiliated career within each state. Reported wages are divided by the cost of living index for the state of the
occupation so that adjusted wage can be compared across states given degree and affiliated career.",
style = "color: white"),
h1("Data Sources", style = "color: white"),
h2("The last tab of this dashboard provides a list of data sources. CIP codes were obtained from one university and
seven community colleges. A crosswalk between CIP codes and Standard Occupational Codes (SOC) is provided by the
National Center of Educational Statistics in partnership with the Bureau of Labor Statistics.
The employment data were obtained from Projections Central through the Projections Managing Partnership.
wage data were collected and compiled from the Bureau of Labor Statistics.", style = "color: white"),
h2("Some wage data may be null or missing. This is typically due to suppression of these data by the Bureau of Labor
Statistics for small sample sizes or irrelevant data categories.", style = "color: white"),
h2("Only degrees with CIP codes affiliated with SOC codes are included in the data set.",
style = "color:white"),
fluidRow(
box(width = 10,
downloadButton("dataset", "Download Zipped Data")))),
tabItem(tabName = "datatable",
h1("Degrees and Job wage Projections", align = "center", style = "color: white"),
h2("First select an institution, then a degree program, then one or more states to compare career outcomes.
Data will not appear until you make a selection. You can also download the filtered data as a .csv.",
style = "color: white"),
h3(tags$b("You can scroll horizontally to see wage data by dragging the bar at the bottom of the table.",
style = "color: white")),
h3(tags$b("Rotate your phone or tablet if you cannot scroll through all the columns.", style = "color: white")),
fluidRow(
pickerInput(
inputId ="institutionInput",
label = div("Select one or more institutions:", style = "color: white;"),
choices = sort(unique(Table1$Institution)),
options = list('actions-box' = TRUE),
selected = "University",
multiple = TRUE)),
fluidRow(
pickerInput(
inputId ="credentialInput",
label = div("Select one or more degrees:", style = "color: white;"),
choices = sort(unique(Table1$Program)),
options = list('actions-box' = TRUE),
multiple = TRUE)),
fluidRow(
pickerInput(
inputId = "areaInput",
label = div("Select one or more areas for careers:", style = "color: white;"),
choices = sort(unique(Table1$Area_Name)),
options = list('actions-box' = TRUE),
multiple = TRUE)),
downloadButton("downloadData", "Download the Filtered Data"),
fluidRow(
box(width = 10, DT::dataTableOutput("projections")))),
tabItem(tabName = "dictionary",
h1("Data Dictionary", align = "center", style = "color: white"),
fluidRow(
box(width = 10, DT::dataTableOutput("dictionarytable")))),
tabItem(tabName = "references",
h1("Data Sources", align = "center", style = "color: white"),
h3("About the PMP (2021). Projections Central. Retrieved November 14, 2021 from https://projectionscentral.org/",
style = "color: white"),
h3("About the U.S. Bureau of Labor Statistics (2021).
U.S. Bureau of Labor Statistics. Retrieved November 15, 2021 from https://www.bls.gov/bls/infohome.htm",
style = "color: white"),
h3("Missouri Economic and Research Information Center (2022). Cost of living data series. Retrieved January 3, 2022
from https://meric.mo.gov/data/cost-living-data-series", style = "color: white"),
h3("National Center for Education Statistics (2021).
CIP User Site. CIP SOC Crosswalk. Retrieved November 15, 2021 from
https://nces.ed.gov/ipeds/cipcode/post3.aspx?y=56", style = "color: white"),
h3("Occupational Employment and Wage Statistics Home Page (2021).
Retrieved November 5, 2021, from https://www.bls.gov/oes/", style = "color: white"),
h3("U.S. Bureau of Labor Statistics. (2021). May 2020 National Occupational Employment and
Wage Estimates. Occupational Employment and Wage Statistics PRINT:Print OEWS
OEWS Program Links. Retrieved November 5, 2021, from https://www.bls.gov/oes/current/oes_nat.htm#00-0000",
style = "color: white"))))
)
server <- function(input, output, session){
institutionDegree<- reactive({
filter(Table1, Institution %in% input$institutionInput)
})
observeEvent(institutionDegree(), {
choices <- sort(unique(institutionDegree()$Program))
updatePickerInput(session = session, inputId = "credentialInput", choices = choices, selected = Table1$Institution)
})
programDegree <- reactive({
req(input$credentialInput)
filter(institutionDegree(), Program %in% input$credentialInput)
})
observeEvent(programDegree(), {
choices <- sort(unique(programDegree()$Area_Name))
updatePickerInput(session = session, inputId = "areaInput", choices = choices, selected = Table1$Program)
})
output$dataset <- downloadHandler(
filename = function() {
paste("zipfile", ".zip", sep = "")
},
content = function(file) {
file.copy("zipfile.zip", file)
}
)
output$projections <-
DT::renderDataTable(datatable(extensions = c("FixedHeader", "FixedColumns"),
options= list(autoWidth=TRUE,
scrollX = TRUE, searching = FALSE, fixedColumns = list(leftColumns = 5), fixedHeader=TRUE),{
req(input$areaInput)
programDegree()%>%
filter(Area_Name %in% input$areaInput)
})
%>%formatPercentage("Percent.Change", 0)
%>%formatCurrency(c("Hourly_Adjusted_Median", "Annual_Adjusted_Median"), currency = "$"))
output$downloadData <- downloadHandler(
filename = function() {
paste("Careers", ".csv", sep="")
},
content = function(file) {
write.csv(programDegree()%>%
filter(Area_Name %in% input$areaInput), file)
}
)
output$dictionarytable <- DT::renderDataTable(
datadictionary,
options = list(scrollX = TRUE))
}
shinyApp(ui=ui, server=server)
