In Class Solo Tasks, Winter '23

# This code will load the R packages we will use suppressPackageStartupMessages({ library(coursekata) })

collegemobility <- read.csv("collegemobility.csv") head(collegemobility)

glimpse(collegemobility)

There are 2,199 colleges included in this dataset!

tally(collegemobility$tier == 1) tally(collegemobility$tier == 2) tally(collegemobility$tier == 3) tally(collegemobility$tier == 4) tally(collegemobility$tier == 5) tally(collegemobility$tier == 6) tally(collegemobility$tier == 7) tally(collegemobility$tier == 8) tally(collegemobility$tier == 9) tally(collegemobility$tier == 10) tally(collegemobility$tier == 11) tally(collegemobility$tier == 12)

There are 12 tier one universities, 64 tier two, 26 tier three, 71 tier four, 375 tier five, 584 tier six, 74 tier seven, 79 tier eight, 718 tier nine, 78 tier ten, 72 tier eleven, and 46 tier twelve.

gf_histogram(~median_family_income, data=collegemobility, fill="slategrey") %>% gf_vline(xintercept=53657, color = "darkred")

The median household income in the United States is lower than the median income of college-attending families. Higher-income families are more likely to attend university.

I predict that very few students would start from the bottom 20% of income and make it to the top 20% of earners as adults -- a low enough percentage of them that it couldn't just be by random chance. I think coming from a low-income household has a significant negative correlation to having a high income as an adult.

To put it to a number... maybe 10%? Probably less.

empty_model <- lm(percent_from_bottom_20_and_reached_top_20 ~ NULL, data = collegemobility) empty_model

tier1 <- data.frame(filter(collegemobility, tier == 1)) mean(tier1$percent_from_bottom_20_and_reached_top_20)

Only 2%! My estimate was way too high!

filter(collegemobility, name == "Seattle Pacific University")

tier6 <- data.frame(filter(collegemobility, tier == 6)) mean(tier6$percent_from_bottom_20_and_reached_top_20)

SPU is a tier 6 school! Their percentage is only 1.35% -- very low! They're actually lower than the mean for their tier, which is 1.70%.