College Scorecard School Data

I am using the available API provided by College Scorecard to extract the relevant school data. The College Scorecard combines data from the Integrated Postsecondary Education Data System (IPEDS), National Student Loan Data System (NSLDS), and various other sources into one dataset and makes it available through an API. The extraction process includes selecting the desired data fields (there are a ton to choose from), determining which years to pull data for, and creating the API call to return the data. The latest full dataset available is for the 2015-2016 school year. I will be extracting the last 5 school years worth of data (2011-2012, 2012-2013, 2013-2014, 2014-2015, 2015-2016).

In R, there is an existing package called rscorecard that “is simply a method for converting idiomatic R code into a properly formatted URL string that is then queried.” This package does require an API key which I requested here. I added the API key to a .Renviron file to maintain security best practices.

years <- seq(2011, 2015)

# get school data for all 4-year schools that are public or private non-profit for desired years and combine it all into one tibble
school_data_staging <- map_dfr(years, ~
  sc_init() %>%
    sc_filter(ICLEVEL == 1, CONTROL == 1:2) %>%
    sc_select(UNITID, OPEID, OPEID6, INSTNM, CITY, STABBR, ZIP, INSTURL, MAIN, CONTROL, REGION, LATITUDE, LONGITUDE, ADM_RATE, SATVR25, SATVR75, SATMT25, SATMT75, SATVRMID, SATMTMID, ACTCM25, ACTCM75, ACTEN25, ACTEN75, ACTMT25, ACTMT75, ACTCMMID, ACTENMID, ACTMTMID, UGDS, TUITIONFEE_IN, TUITIONFEE_OUT, C150_4, RET_FT4, PCTFLOAN, GRAD_DEBT_MDN, GRAD_DEBT_MDN10YR, LOAN_EVER, ALIAS, C100_4, ICLEVEL) %>%
    sc_year(.x) %>%
    sc_get()
)

Football Data

For the football data, I am going to scrape data from http://www.sports-reference.com, a sports statistics clearinghouse that allows free downloads of data. You can export this data to CSVs, but I’m going to scrape it so I don’t have to deal with multiple CSV files. To mirror the school data, I will be extracting the data for the same school years as mentioned above (2011-2012, 2012-2013, 2013-2014, 2014-2015, 2015-2016). I’ll also be getting data for bowl games. The bowl data is on a separate webpage of the site.

get_football_data <- function(games, years) {
  if (!(games %in% c("schedule", "bowls"))) {
    stop("Game arg must be either 'schedule' or 'bowls'", call. = FALSE)
  }
  # create urls based on the desired years and if user wants all games or bowl games
  urls <- paste0("https://www.sports-reference.com/cfb/years/",years,"-",games,".html")

  # get html from urls
  urls_html <- map(urls, ~ read_html(.x))

  # get the data for each url and combine it into one data table
  football_data <- rbindlist(map(urls_html, ~ .x %>%
                                   html_nodes("table") %>%
                                   .[[1]] %>%
                                   html_table()), fill = TRUE) # fill = true here because different years have different columns included in the data
  return(football_data)
}

football_data_staging <- get_football_data("schedule", years)
football_data_staging_bowls <- get_football_data("bowls", years)

School Data

I’ll start with the school data. Overall, it’s in pretty good shape. The main things to do are rename the columns so they are a little more user friendly and decode columns like “CONTROL”, “ICLEVEL”, “REGION”, etc. so that instead of containing numbers they contain what those numbers mean (e.g. a “CONTROL” value of 1 means it is a public school).

I’ll also include the full state name based on the state abbreviation. The decoded values can be found in the College Scorecard data dictionary.

clean_school_data <- function(dirty_data) {
  state_lookups <- read_csv("https://raw.githubusercontent.com/jennaallen/football_schools/master/lookups.csv") %>%
    filter(VariableName == "State abbreviation (HD2016)") %>%
    select(Value, ValueLabel)
  
  clean_data <- dirty_data %>%
    mutate(region = recode(region,
                           "0"  = "US Service schools",
                           "1"  = "New England",
                           "2"  = "Mid East",
                           "3"  = "Great Lakes",
                           "4"  = "Plains",
                           "5"  = "Southeast",
                           "6"  = "Southwest",
                           "7"  = "Rocky Mountains",
                           "8"  = "Far West",
                           "9"  = "Outlying"),
           control = recode(control,
                            "1" = "Public",
                            "2" = "Private not-for-profit"),
           iclevel = recode(iclevel,
                            "1" = "4-year",
                            "2" = "2-year",
                            "3" = "Less-than-2-year"),
           zip = str_sub(zip, end = 5), # keep only the first 5 numbers for zip code; some values are missing dash between zip and zip +4 code
          school_size_category = case_when(ugds < 1000 ~ "Under 1,000",
                                           between(ugds, 1000, 4999) ~ "1,000 - 4,999",
                                           between(ugds, 5000, 9999) ~ "5,000 - 9,999",
                                           between(ugds, 10000, 19999) ~ "10,000 - 19,999",
                                           ugds > 20000 ~ "20,000 and above",
                                           TRUE ~ NA_character_)) %>%
    left_join(state_lookups, by = c("stabbr" = "Value")) %>%
    rename("ACT_composite_25th_percentile" = actcm25,
           "ACT_composite_75th_percentile" = actcm75,
           "ACT_composite_midpoint" = actcmmid,
           "ACT_english_25th_percentile" = acten25,
           "ACT_english_75th_percentile" = acten75,
           "ACT_english_midpoint" = actenmid,
           "ACT_math_25th_percentile" = actmt25,
           "ACT_math_75th_percentile" = actmt75, 
           "ACT_math_midpoint" = actmtmid,
           "school_admission_rate" = adm_rate,
           "school_alias" = alias,
           "school_graduation_rate_4yrs" = c100_4,
           "school_graduation_rate_6yrs" = c150_4,
           "school_city" = city,
           "school_control" = control,
           "school_median_debt_graduates" = grad_debt_mdn,
           "school_median_debt_graduates_monthly_payments" = grad_debt_mdn10yr,
           "school_name" = instnm,
           "school_url" = insturl,
           "school_latitude" = latitude,
           "school_level" = iclevel,
           "school_students_with_any_loan" = loan_ever,
           "school_longitude" = longitude,
           "school_main_campus_flag" = main,
           "school_opeid8" = opeid,
           "school_opeid6" = opeid6,
           "school_federal_loan_rate" = pctfloan,
           "school_region" = region,
           "school_retention_rate" = ret_ft4,
           "SAT_math_25th_percentile" = satmt25,
           "SAT_math_75th_percentile" = satmt75, 
           "SAT_math_midpoint" = satmtmid,
           "SAT_reading_25th_percentile" = satvr25,
           "SAT_reading_75th_percentile" = satvr75, 
           "SAT_reading_midpoint" = satvrmid,
           "school_st_abbr" = stabbr,
           "school_in_state_price" =  tuitionfee_in,
           "school_out_state_price" = tuitionfee_out, 
           "school_size" = ugds,
           "school_id" = unitid,
           "school_state" = ValueLabel,
           "school_year_start" =  year,
           "school_zip" = zip)
  return(clean_data)
}

school_data_transform <- clean_school_data(school_data_staging)

Football Data

The football data is a bit more messy than the school data. For example, the row headers are sometimes repeated in the middle of the dataset. Also, for some schools the ranking precedes the school name (i.e. “(2) Alabama”). As a part of the cleaning process for the football data, I’m also going to join in the bowl game information and create flags for which games were bowl games and which ones were national championship games.

clean_football_data <- function(all_games, bowls) {
  clean_bowls <- bowls %>% 
    set_tidy_names() %>%
    as_tibble() %>%
    mutate_at(vars(Date), ymd) %>% 
    select(Date, Bowl, Winner)
  clean_all_games <- all_games %>%
    set_tidy_names() %>% 
    as_tibble() %>%
    rename(school_points = Pts..6, opponent_points = Pts..9, home_away = V1) %>% 
    mutate_all(funs(replace(., . == '', NA))) %>%
    filter(!(Rk %in% "Rk") & !(Notes %like% "Cancelled")) %>%
    mutate(school_rank = str_extract(Winner, "\\d{1,2}"),
           opponent_rank = str_extract(Loser, "\\d{1,2}"),
           school = str_replace(Winner, "\\(\\d{1,2}\\)\\s", ""),
           opponent = str_replace(Loser, "\\(\\d{1,2}\\)\\s", ""),
           school_game_site = case_when(home_away %in% "@" ~ "away",
                                        is.na(Notes) ~ "home",
                                        TRUE ~ "neutral"),
           opponent_game_site = case_when(school_game_site %in% "away" ~ "home",
                                          school_game_site %in% "home" ~ "away",
                                          TRUE ~ "neutral"),
           school_win = as.integer(1),
           opponent_win = as.integer(0)) %>%
    mutate_at(vars(Rk, Wk, school_points, opponent_points, school_rank, opponent_rank), as.integer) %>% 
    mutate_at(vars(Date), mdy) %>%
    left_join(clean_bowls, by = c("Date" = "Date", "school" = "Winner")) %>% 
    mutate(bowl_flag = if_else(!is.na(Bowl), 1, 0),
           national_championship_flag = if_else(Bowl %like% "Championship", 1, 0)) %>%
    mutate_at(vars(bowl_flag, national_championship_flag), as.integer) %>%
    rename("game_number" = Rk,
           "football_week" = Wk,
           "game_date" = Date,
           "game_day" = Day,
           "football_notes" = Notes,
           "game_time" = Time,
           "game_tv" = TV,
           "bowl" = Bowl) %>% 
    select(-Winner, -Loser, -home_away)
  return(clean_all_games) 
}

football_data_transform <- clean_football_data(football_data_staging, football_data_staging_bowls)

Now that the school and football data are clean, I’m ready to create the data model.

dimSchool

Now that I have a connection to the database. I can write the data to it. I could setup the dimSchool table as a type 2 slowly changing dimension, but I decided that I did not need a history of the changes from 2011 to 2015. I found that the changes from one year to the next were minor. Thus, I setup the dimSchool dimension as a type I slowly changing dimension. As a result, you’ll notice that I’m only including the school information from the latest school year that I have, which is 2015.

# filter for only 2015 data and only columns needed for dimSchool
dimSchool <- school_data_transform %>%
  semi_join(fuzzy_text_final, by = "school_name") %>% 
  bind_rows(missing_school_data) %>% 
  filter(school_year_start %in% max(school_year_start)) %>%
  select(school_id,
         school_name,
         school_alias,
         school_city,
         school_st_abbr,
         school_state,
         school_zip,
         school_region,
         school_longitude,
         school_latitude,
         school_main_campus_flag,
         school_size_category,
         school_url,
         school_control,
         school_level)

dbWriteTable(con, name = "dimSchool", value = dimSchool , append = TRUE, row.names = FALSE)

dimDate and dimSchoolYear

Before I can load the fact tables, I need to create the dimDate and dimSchoolYear tables and load them into the data warehouse.

create_date_table <- function(start_year) {
  d <- tibble(date_value = seq(mdy(paste0("01/01/", start_year)), by = "day", length.out = 6940),
              date_sk = as.integer(format(date_value, format = "%Y%m%d")),
              school_year_sk = if_else(month(date_value) %in% c(1, 2, 3, 4, 5, 6, 7), as.integer(year(date_value) - 1), as.integer(year(date_value))),
              month_value = month(date_value),
              day_value = day(date_value),
              year_value = year(date_value),
              day_of_week_value = wday(date_value),
              day_of_week_name = wday(date_value, label = TRUE, abbr = FALSE),
              month_name = month(date_value, label = TRUE, abbr = FALSE)) %>% 
               select(date_sk, school_year_sk, everything())
  return(d)
}

dimDate <- create_date_table(2011)

dbWriteTable(conn = con, name = 'dimDate', value = dimDate, append = TRUE, row.names = FALSE)

create_school_year <- function(dates) {
  # x should be dimDate or equivalent
  s <- dates %>% 
    mutate(school_year_value = school_year_sk) %>% 
    select(school_year_sk, school_year_value) %>% 
    distinct()
  return(s)
}

dimSchoolYear <- create_school_year(dimDate)

dbWriteTable(conn = con, name = 'dimSchoolYear', value = dimSchoolYear, append = TRUE, row.names = FALSE)

factGame

In the game source data, one row represents two schools, both a winner and loser. In the data warehouse I want to represent a game from each school’s perspective. Therefore, I loaded two rows for each game and defined the school columns in the table as ‘school’ and ‘opponent.’ This allowed me to load both the winner and the loser into the same column on two different rows. For analysis, this permitted me to obtain data for both winners and losers by querying just one column, either ‘school’ or ‘opponent’.

create_factGame <- function(football, dates, text_match) {
  # football should be clean, transformed football data
  # dates should be the dimDate table or equivalent
  # text_match should be the final fuzzy text matching data
  # get SKs
  school_opponent_sks <- dbGetQuery(con, "SELECT school_sk, school_name
                                    FROM FootballSchoolDW.dimSchool")
  
  # create unique game id by concantenating the school year with the original game number
  final_football_data <- football %>% 
    left_join(select(dates, date_value, date_sk, school_year_sk), by = c("game_date" = "date_value")) %>%
    unite(game_id, school_year_sk, game_number, sep = "") %>%
    mutate_at(vars(game_id), as.integer) %>% 
    left_join(text_match, by = c("school" = "football_name")) %>% 
    rename(school_lookup = school_name) %>% 
    left_join(school_opponent_sks, by = c("school_lookup" = "school_name")) %>% 
    left_join(text_match, by = c("opponent" = "football_name")) %>% 
    rename(opponent_lookup = school_name) %>% 
    left_join(school_opponent_sks, by = c("opponent_lookup" = "school_name")) %>% 
    rename(school_sk = school_sk.x, opponent_sk = school_sk.y) 
                          
  if (any(is.na(final_football_data$school_sk))) { 
    warning("Some school SKs are NA. Check before loading data into database.", call. = FALSE)
  }
  if (any(is.na(final_football_data$opponent_sk))) { 
    warning("Some opponent SKs are NA. Check before loading data into database.", call. = FALSE)
  }

  winner <- final_football_data %>% 
    select(school_sk,
           opponent_sk,
           date_sk,
           game_id,
           school_points,
           opponent_points,
           school_win,
           football_notes,
           school_rank,
           opponent_rank,
           school_game_site,
           opponent_game_site,
           bowl, 
           bowl_flag,
           national_championship_flag)
    
  loser <- final_football_data %>%
    select(opponent_sk,
           school_sk,
           date_sk,
           game_id,
           opponent_points,
           school_points,
           opponent_win,
           football_notes,
           opponent_rank,
           school_rank,
           opponent_game_site,
           school_game_site,
           bowl,
           bowl_flag,
           national_championship_flag)
  
  # I intentionally want to bind these two tibbles together by the column orders
  # specified above so I get a row for the school and a row for the opponent in the final table
  final_football_ordered <- rbindlist(list(winner, loser)) %>% 
    as_tibble() %>% 
    arrange(game_id)
  return(final_football_ordered)
}

factGame <- create_factGame(football_data_transform, dimDate, fuzzy_text_final)

dbWriteTable(conn = con, name = 'factGame', value = factGame, append = TRUE, row.names = FALSE)

factSchool

Finally, the factSchool table was loaded. The school_year was obtained from the snowflaked dimSchoolYear table, the school_sk was obtained from the dimSchool table.

create_factSchool <- function(school, missing_data, school_year, text_match) {
  # school should be clean, transformed school data
  # missing_data is the missing school data
  # school_year should be the dimSchoolYear table or equivalent
  # text_match should be the final fuzzy text matching data
  # get SKs
  school_sks <- dbGetQuery(con, "SELECT school_sk, school_name 
                           FROM FootballSchoolDW.dimSchool")
  
  final_school_data <- school %>%
    semi_join(text_match, by = "school_name") %>% 
    bind_rows(missing_data) %>% 
    left_join(school_sks, by = "school_name") %>% 
    left_join(school_year, by = c("school_year_start" = "school_year_value")) %>%
    select(school_sk, 
           school_year_sk, 
           school_admission_rate, 
           school_in_state_price,
           school_out_state_price,
           school_retention_rate,
           school_graduation_rate_4yrs,
           school_graduation_rate_6yrs,
           school_federal_loan_rate,
           school_students_with_any_loan,
           school_median_debt_graduates,
           school_median_debt_graduates_monthly_payments,
           SAT_reading_25th_percentile, 
           SAT_reading_75th_percentile,
           SAT_math_25th_percentile,
           SAT_math_75th_percentile,
           SAT_reading_midpoint,
           SAT_math_midpoint,
           ACT_composite_25th_percentile,
           ACT_composite_75th_percentile,
           ACT_english_25th_percentile,
           ACT_english_75th_percentile,
           ACT_math_25th_percentile,
           ACT_math_75th_percentile,
           ACT_composite_midpoint,
           ACT_english_midpoint,
           ACT_math_midpoint)
  
  if (any(is.na(final_school_data$school_sk))) { 
    warning("Some school SKs are NA. Check before loading data into database.", call. = FALSE)
  }
  return(final_school_data)
}

factSchool <- create_factSchool(school_data_transform, missing_school_data, dimSchoolYear, fuzzy_text_final)

dbWriteTable(conn = con, name = 'factSchool', value = factSchool, append = TRUE, row.names = FALSE)

Create View in SQL

Now that all of the data is loaded into the database, I’m going to create a view using SQL that will be used for the analysis/data visualization work. If the dataset were larger, I would consider creating a materialized view, but for this amount of data a regular view will work fine.

CREATE VIEW viewAnalysis AS 
SELECT
  ds.school_id,
    ds.school_name,
    ds.school_city,
    ds.school_st_abbr,
    ds.school_state,
    ds.school_zip,
    ds.school_region,
    ds.school_longitude,
    ds.school_latitude,
    ds.school_main_campus_flag,
    ds.school_size_category,
    ds.school_url,
    ds.school_control,
    ds.school_level,
    fs.school_admission_rate,
    fs.school_in_state_price,
    fs.school_out_state_price,
    fs.school_retention_rate,
    fs.school_graduation_rate_4yrs,
    fs.school_graduation_rate_6yrs,
    fs.school_federal_loan_rate,
    fs.school_students_with_any_loan,
    fs.school_median_debt_graduates,
    fs.school_median_debt_graduates_monthly_payments,
    fs.SAT_reading_25th_percentile,
    fs.SAT_reading_75th_percentile,
    fs.SAT_math_25th_percentile,
    fs.SAT_math_75th_percentile,
    fs.SAT_reading_midpoint,
    fs.SAT_math_midpoint,
    fs.ACT_composite_25th_percentile,
    fs.ACT_composite_75th_percentile,
    fs.ACT_english_25th_percentile,
    fs.ACT_english_75th_percentile,
    fs.ACT_math_25th_percentile,
    fs.ACT_math_75th_percentile,
    fs.ACT_composite_midpoint,
    fs.ACT_english_midpoint,
    fs.ACT_math_midpoint,
    sy.school_year_value,
    SUM(fg.school_points) AS school_points,
    SUM(fg.opponent_points) AS opponent_points,
    SUM(fg.school_win) AS school_wins,
    MIN(fg.school_rank) AS min_school_rank,
    MIN(fg.opponent_rank) AS min_opponent_rank,
    SUM(fg.bowl_flag) AS bowl_games,
  SUM(CASE WHEN (fg.bowl_flag = 1 AND fg.school_win = 1)
          THEN 1
      ELSE 0
      END) AS bowl_wins,
    SUM(fg.national_championship_flag) AS national_championship_games,
    SUM(CASE WHEN (fg.national_championship_flag = 1 AND fg.school_win = 1)
          THEN 1
      ELSE 0
      END) AS national_championship_wins,
    SUM(CASE WHEN (fg.school_game_site = 'home' AND fg.school_win = 1)
          THEN 1
          ELSE 0
          END) AS home_wins, 
    SUM(CASE WHEN (fg.school_game_site = 'home' AND fg.school_win = 0)
          THEN 1
          ELSE 0
          END) AS home_loses,
    SUM(CASE WHEN (fg.school_game_site = 'home')
          THEN 1
          ELSE 0
          END) AS home_games,
    SUM(CASE WHEN ((fg.school_game_site = 'away' OR fg.school_game_site = 'neutral' ) AND fg.school_win = 1)
          THEN 1
          ELSE 0
          END) AS road_wins,
    SUM(CASE WHEN ((fg.school_game_site = 'away' OR fg.school_game_site = 'neutral' ) AND  fg.school_win = 0)
          THEN 1
          ELSE 0
          END) AS road_loses,
    SUM(CASE WHEN (fg.school_game_site = 'away' OR fg.school_game_site = 'neutral' )
          THEN 1
          ELSE 0
          END) AS road_games,
    SUM(CASE WHEN (fg.opponent_rank IS NOT NULL AND fg.school_win = 1)
          THEN 1
          ELSE 0
          END) AS wins_against_ranked_opponents,
    SUM(CASE WHEN (fg.opponent_rank IS NOT NULL AND fg.school_win = 0)
          THEN 1
          ELSE 0
          END) AS loses_against_ranked_opponent,
    SUM(CASE WHEN (fg.opponent_rank IS NOT NULL)
          THEN 1
      ELSE 0
      END) AS games_against_ranked_opponent,
    SUM(fg.school_points) - SUM(fg.opponent_points) AS point_differential,
    COUNT(*) as total_games
FROM FootballSchoolDW.factGame AS fg
  INNER JOIN FootballSchoolDW.dimSchool AS ds
  ON fg.school_sk = ds.school_sk
  INNER JOIN FootballSchoolDW.dimDate AS dd
  ON dd.date_sk = fg.date_sk
  INNER JOIN FootballSchoolDW.dimSchoolYear AS sy
  ON dd.school_year_sk = sy.school_year_sk
  INNER JOIN FootballSchoolDW.factSchool AS fs
  ON fs.school_sk = ds.school_sk and fs.school_year_sk = sy.school_year_sk
  GROUP BY 
    ds.school_id,
    ds.school_name,
    ds.school_city,
    ds.school_st_abbr,
    ds.school_state,
    ds.school_zip,
    ds.school_region,
    ds.school_longitude,
    ds.school_latitude,
    ds.school_main_campus_flag,
    ds.school_size_category,
    ds.school_url,
    ds.school_control,
    ds.school_level,
    fs.school_admission_rate,
    fs.school_in_state_price,
    fs.school_out_state_price,
    fs.school_retention_rate,
    fs.school_graduation_rate_4yrs,
    fs.school_graduation_rate_6yrs,
    fs.school_federal_loan_rate,
    fs.school_students_with_any_loan,
    fs.school_median_debt_graduates,
    fs.school_median_debt_graduates_monthly_payments,
    fs.SAT_reading_25th_percentile,
    fs.SAT_reading_75th_percentile,
    fs.SAT_math_25th_percentile,
    fs.SAT_math_75th_percentile,
    fs.SAT_reading_midpoint,
    fs.SAT_math_midpoint,
    fs.ACT_composite_25th_percentile,
    fs.ACT_composite_75th_percentile,
    fs.ACT_english_25th_percentile,
    fs.ACT_english_75th_percentile,
    fs.ACT_math_25th_percentile,
    fs.ACT_math_75th_percentile,
    fs.ACT_composite_midpoint,
    fs.ACT_english_midpoint,
    fs.ACT_math_midpoint,
    sy.school_year_value
  ORDER BY sy.school_year_value

# disconnect from RDS
dbDisconnect(con)