Skip to content

Instantly share code, notes, and snippets.

@fouadyared
Created May 1, 2017 01:07
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save fouadyared/4b7c1cc33556480ac7de9de739c75ffd to your computer and use it in GitHub Desktop.
Save fouadyared/4b7c1cc33556480ac7de9de739c75ffd to your computer and use it in GitHub Desktop.
Files for "University Return on Investment" Shiny App (by Fouad Yared)
library(shiny)
library(shinyBS)
library(shinydashboard)
library(leaflet)
library(ggplot2)
library(dplyr)
library(plotly)
library(RColorBrewer)
library(geojsonio)
library(data.table)
library(tidyr)
library(rgdal)
library(scales)
#main dataset (from US Dept of Education, joined with Treasury data)
univDT_Cut <-
fread('univDT_JoinedWcorrectROI1_Cut.csv',
stringsAsFactors = F)
#100 cities with the most universities
cc100DT <- fread(input = 'cc100DT.csv', stringsAsFactors = F)
#colors set for theamtic map in "Earnings in the US" tab
pal <- colorNumeric("Blues", domain = NULL,
reverse = FALSE)
#metro/micropolitan shapefile
usMetrosJson5Simp <-
geojsonio::geojson_read("metros5Simp.geojson", what = "sp")
#fields converted into numeric
#shown when hovering over the map
usMetrosJson5Simp$metroJoin_DifBAHS15 <- as.numeric(levels(usMetrosJson5Simp$metroJoin_DifBAHS15))[usMetrosJson5Simp$metroJoin_DifBAHS15]
usMetrosJson5Simp$metroJoin_HSorGED15 <- as.numeric(levels(usMetrosJson5Simp$metroJoin_HSorGED15))[usMetrosJson5Simp$metroJoin_HSorGED15]
usMetrosJson5Simp$metroJoin_Bachelorsdegree15 <- as.numeric(levels(usMetrosJson5Simp$metroJoin_Bachelorsdegree15))[usMetrosJson5Simp$metroJoin_Bachelorsdegree15]
function(input, output, session) {
observe({
univ <- unique(univDT_Cut[City.x == input$city, "Name"])
updateSelectizeInput(
session, "name",
choices = univ)
})
#call from input$city to change univerities shown on boxplot
output$boxy2 <- renderPlot(
univDT_Cut %>%
filter(City.x == input$city &
!is.na(Earning_10Perc_Af6Yr) &
!is.na(Earning_25Perc_Af6Yr) &
!is.na(Earning_Med_Af6Yr) &
!is.na(Earning_75Perc_Af6Yr) &
!is.na(Earning_90Perc_Af6Yr)) %>%
arrange(desc(Earning_Med_Af6Yr)) %>%
head(20) %>%
ggplot(aes(x=reorder(Name,
Earning_Med_Af6Yr),
ymin = Earning_10Perc_Af6Yr,
lower = Earning_25Perc_Af6Yr,
middle = Earning_Med_Af6Yr,
upper = Earning_75Perc_Af6Yr,
ymax = Earning_90Perc_Af6Yr,
fill = PrivPrice_4YRs4,
order = Earning_Med_Af6Yr)) +
geom_boxplot(stat = "identity") +
coord_flip() +
scale_y_continuous(
name = "Income after 6 Years (for graduates)",
labels = comma) +
scale_x_discrete(
name = "Names of Universities"
) +
scale_fill_gradient(low = "snow", high = "skyblue",
name="Earnings by University, by City",
labels=c("0-25k","25-50k","50-75k",
"75-100k", "100-125k", "125-150k", "150-175k",
"175-200k", "200k+"),
breaks = c(0, 25000, 50000, 75000, 100000,
125000, 150000, 175000, 200000)
) +
theme(
#legend.position='top',
axis.text.x = element_text(size = 14),
axis.text.y = element_text(size = 14),
axis.title = element_text(size = 16)
) +
geom_text(aes(label = comma(Earning_Med_Af6Yr),
y = Earning_Med_Af6Yr),
position = position_stack(vjust = 0.8),
size = 5
#position=position_dodge(width=0.9)
)
)
#map showing locations/clusters of all universities. centered at the middle of US
output$mapy2 <- renderLeaflet({
leaflet(univDT_Cut) %>%
setView(lng = -97.348603,
lat = 37.684592,
zoom = 4) %>%
addProviderTiles(providers$Esri.NatGeoWorldMap) %>%
addMarkers(
clusterOptions = markerClusterOptions()
)
})
#map showing difference in salary for BA recipients and HS grads
output$mapy3 <- renderLeaflet({
leaflet(usMetrosJson5Simp) %>%
setView(lng = -97.348603,
lat = 37.684592,
zoom = 4) %>%
addTiles() %>%
addPolygons(stroke = FALSE,
smoothFactor = 0.3, fillOpacity = 1,
weight = 0,
fillColor = ~pal(as.numeric(metroJoin_DifBAHS15)),
label = ~paste0(NAMELSAD, ": ",
formatC(as.numeric(metroJoin_DifBAHS15),
big.mark = ",",
digits = 7),
" HS: ",
formatC(metroJoin_HSorGED15,
big.mark = ",",
digits = 7),
" BA: ",
formatC(metroJoin_Bachelorsdegree15,
big.mark = ",",
digits = 7),
" "
),
labelOptions = labelOptions(noHide = T,
direction = 'top',
offset=c(0,-45))
)
})
#based on input$name, data table showing range of university earnings
output$datatable = renderDataTable({
univDT_Cut[Name == input$name,
c('Name',
'Earning_10Perc_Af6Yr',
'Earning_25Perc_Af6Yr',
'Earning_Med_Af6Yr',
'Earning_Mean_Af6Yr' ,
'Earning_75Perc_Af6Yr',
'Earning_90Perc_Af6Yr'
), drop = FALSE]
})
#based on input$city, table showing earnings and roi
#by universities in select city
output$datatable1 = renderDataTable({
univDT_Cut[City.x == input$city,
c('Name',
'Earning_Med_Af6Yr',
'Earning_Mean_Af6Yr',
'Instate_ROIb',
'Oustate_ROIb',
'Pub_ROIb',
'Priv_ROIb'), drop = FALSE]
})
#boxplot showing private tuition compared to roi
output$boxy3 <- renderPlot(
univDT_Cut %>%
filter(City.x == input$city &
!is.na(PrivPrice_4YRs) &
!is.na(Priv_ROIb) &
!is.na(Priv_ROIb_Cut)
) %>%
group_by(Priv_ROIb_Cut) %>%
summarise(md_Private_ROIb =
median(Priv_ROIb, na.rm = F),
P10_Private_ROIb =
quantile(Priv_ROIb, .1, na.rm = F),
P25_Private_ROIb =
quantile(Priv_ROIb, .25, na.rm = F),
P75_Private_ROIb =
quantile(Priv_ROIb, .75, na.rm = F),
P90_Private_ROIb =
quantile(Priv_ROIb, .90, na.rm = F)
) %>%
ggplot(aes(x =Priv_ROIb_Cut,
ymin = P10_Private_ROIb,
lower = P25_Private_ROIb,
middle = md_Private_ROIb,
upper = P75_Private_ROIb,
ymax = P90_Private_ROIb,
fill = Priv_ROIb_Cut)) +
geom_boxplot(stat = "identity") +
xlab("Private University Price, for 4 years") +
scale_y_continuous(
name = "Private University ROI, For 20 Years",
limits = c(-100000, 750000),
labels = comma) +
scale_fill_gradient(low = "snow", high = "skyblue",
name="Priv. Univ. Cost",
#labels=c("0-25k","25-50k","50-75k",
# "75-100k", "100-125k", "125-150k", "150-175k",
# "175-200k", "200k+"),
breaks = c(0, 25000, 50000, 75000, 100000,
125000, 150000, 175000, 200000)
) +
theme(
#legend.position='top',
axis.text.x = element_text(size = 14),
axis.text.y = element_text(size = 14),
axis.title = element_text(size = 16)
) +
geom_text(aes(label = comma(md_Private_ROIb),
y = md_Private_ROIb),
position = position_stack(vjust = 0.8),
size = 5)
)
#boxplot showing median earnings by 20% share of stem degrees
output$boxy4 <- renderPlot(
univDT_Cut %>%
filter(City.x == input$city &
!is.na(Stem_Perc) &
!is.na(Priv_ROIb)) %>%
ggplot(aes(Stem_Perc, Priv_ROIb)) +
geom_boxplot(aes(group = Stem_Perc)) +
theme(
axis.text.x = element_text(size = 14),
axis.text.y = element_text(size = 14),
axis.title = element_text(size = 16)
) +
xlab("Share of Stem Degrees Awarded, in 20% intervals") +
scale_y_continuous(
name = "Private University ROI, For 20 Years",
#limits = c(-100000, 750000),
labels = comma) +
scale_fill_gradient(low = "snow", high = "skyblue",
name="Share of Stem Degrees by ROI")
)
#boxplot showing median earnings by rank of research institution
output$boxy6 <- renderPlot(
univDT_Cut %>%
filter(City.x == input$city &
!is.na(researchUni) &
!is.na(Priv_ROIb)) %>%
ggplot(aes(researchUni, Priv_ROIb)) +
geom_boxplot(aes(group=researchUni)) +
theme(
axis.text.x = element_text(size = 14),
axis.text.y = element_text(size = 14),
axis.title = element_text(size = 16)
) +
xlab("Ranking of Research Institution, R1, R2, R3") +
scale_y_continuous(
name = "Private University ROI, For 20 Years",
#limits = c(-100000, 750000),
labels = comma) +
scale_fill_gradient(low = "snow", high = "skyblue",
name="Institution Rank by ROI")
)
}
dashboardPage(
dashboardHeader(title = "University ROI"),
dashboardSidebar(
sidebarMenu(
#menuitems shown on sidebarMenu
menuItem("Earnings by City",
tabName = "earningsByCity",
icon = icon("institution")),
#inputs on sidebarMenu
selectizeInput("city", "Select a city:",
cc100DT$City),
selectizeInput("name",
"Select a college or university:",
univDT_Cut$Name),
menuItem("Salary Range, by University",
tabName = "datatable",
icon = icon("institution")),
menuItem("Salary, ROI by City",
tabName = "datatable1",
icon = icon("institution")),
menuItem("Earnings in the US",
tabName = "earnings",
icon = icon("map-o")),
menuItem("University Location",
tabName = "univMenu",
icon = icon("map-o")),
menuItem("STEM by ROI",
tabName = "StemDegrees",
icon = icon("institution")),
menuItem("Private Tuition by ROI",
tabName = "private",
icon = icon("institution")),
menuItem("Research Institute Ranking",
tabName = "ResearchUniv",
icon = icon("institution"))
)
),
#boxplots showing earnings by university
dashboardBody(
tabItems(
tabItem(tabName = "earningsByCity",
fluidRow(
box(title = "Private Tuition by Private ROI",
status = "primary",
solidHeader = TRUE,
collapsible = FALSE,
plotOutput("boxy2"),
width = '100%'
)
)
),
#map showing university locations in the US
tabItem(tabName = "univMenu",
fluidRow(
box(title = "Locations of US Universities",
status = "primary",
solidHeader = TRUE,
collapsible = FALSE,
leafletOutput("mapy2"),
width = '100%'
)
)
),
#map showing difference in salary for one-year (BA-HS)
tabItem(tabName = "earnings",
fluidRow(
box(title = "Annual salary difference by geography (BA - HS)",
status = "primary",
solidHeader = TRUE,
collapsible = FALSE,
leafletOutput("mapy3"),
width = '100%'
)
)
),
#table showing salary range by university
tabItem(tabName = "datatable",
fluidRow(
box(title = "Salary Range, by University",
status = "primary",
solidHeader = TRUE,
collapsible = FALSE,
dataTableOutput("datatable"),
width = '100%'
)
)
),
#table showing average salary, roi for many universities in a city
tabItem(tabName = "datatable1",
fluidRow(
box(title = "Average Salary (1 Yr), Return on Investment (20 Yrs)",
status = "primary",
solidHeader = TRUE,
collapsible = FALSE,
dataTableOutput("datatable1"),
width = '100%'
)
)
),
#boxplot showing earnings by university
tabItem(tabName = "private",
fluidRow(
box(title = "Earnings, by University",
status = "primary",
solidHeader = TRUE,
collapsible = FALSE,
plotOutput("boxy3"),
width = '100%'
)
)
),
#boxplot showing share of stem degrees by private ROI
tabItem(tabName = "StemDegrees",
fluidRow(
box(title = "Share of stem degrees by Private ROI",
status = "primary",
solidHeader = TRUE,
collapsible = FALSE,
plotOutput("boxy4"),
width = '100%'
)
)
),
#boxplot showing research universities by private ROI
tabItem(tabName = "ResearchUniv",
fluidRow(
box(title = "University Research Ranking by Private ROI (List: wikipedia.org/wiki/List_of_research_universities_in_the_United_States)",
status = "primary",
solidHeader = TRUE,
collapsible = FALSE,
plotOutput("boxy6"),
width = '100%'
)
)
)
)
)
)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment