(This article was originally published at Data - Ilan Man, and syndicated at StatsBlogs.)
The UCI Machine learning repository houses a plethora of analyzable data sets. One that I've always thought was interesting is the US adult census data. This data set is based on the 1994 US census, filtered by working adults. The goal is to predict whether an adult in 1994 will make an income of greater or less than $50,000. Why $50K? Is it the minimum threshold for happiness? I don't know, but while $50K might not seem like much today, consider that it's equivalent to about $78.5K today. Not too shabby. And while 1994 was a wastershed year, a lot has changed since then so some of the predictors we'll analyze might not be as relevant today. Although I suspect some are. The data set includes tons of predictor variables, such as age, gender, education level, race, working class, relationship, marital status, capital gain/loss, etc... all of which attempt to predict whether the person makes more or less than $50K. Note that establishing clear causal relationships between income and various social/cultural/demographic variables is a daunting task that everyone struggles with, and is debated by many. I'm not claiming to have found the perfect relationship, just highlighting some interesting observations, and showing how easy it is to code this stuff in R.
I didn't want my analysis to include all of the variables available in the data set, partly because some of them aren't relevant to determining income level, but also because it might lead to overfitting. Therefore I chose to relate income level to age, education level, number of hours worked per week and gender.
Let's start with some basic stuff. What happens to your probability of making greater than $50K as you work more hours during the week? Let's assume you're a 30 year old dude with a bachelor's degree:
Looks pretty benign. As you work more, the probability of making > $50K increases. Notice that it's almost a linear increase. Could your time be better spent by focusing your efforts elsewhere, say, in getting more education? Let's check it out.
Side note: For you nerds out there, I'm performing a logistic regression, and the odds ratio for the hours-worked predictor variable is close to 1, hence the almost straight line.
Holding age and gender constant, let's see how income varies by education level, for different hours worked.
Right. What this says is that for someone to have a 50% chance (the red line) of making more than $50K a year, they could either work upwards of 70 hours a week, with a high school education, or chill at 20 hours a week with a post-grad degree. Or somewhere in the middle. I guess it's cool to stay in school after all. Definitely beats being a fool.
Next, I want to talk about sex. Sex data that is. I compared male and female 30 year olds, working 45 hours a week, with varying levels of education.
Clearly men are much more likely to make $50K than women, but I think you'd have to have a lot of rocks in your head to not except some discrepancy. What's interesting though is the curvature (or convexity) of each graph. The Female curve dips more than the Male curve. This is telling us that the more educated men are, the more likely they are to make $50K vs. women. At the lower levels of education, the difference is much smaller. Could this mean that men's prospects for earning $50K are greater than a women's prospect, after a certain baseline level of education? Or are there confounding variables here? That is, maybe less educated women are getting married more than higher educated women? How does marital status impact this analysis? Let's see:
Right. Married individuals tend to make more money than their single counterparts. And if we saw than making $50K is the key to happiness, marriage must be the solution. On the other hand...
There's much more to dissect here, including the impact of race, working class, and occupation. But that can be a discussion for a future post.
Finally, here's the code to generate the above graphs. Please enjoy and share your comments!
install.packages('XML')
library(XML)
census<-read.csv('http://archive.ics.uci.edu/ml/machine-learning-databases/adult/
adult.data',header=FALSE)
names(census)=c('age','workclass','fnlwgt','education','educationNum',
'maritalStatus','occupation','relationship','race',
'sex','capitalGain','capitalLoss','hoursWeek',
'nativeCountry','income')
head(census)
## Use the first 10,000 records as the training set
df<-census[1:10000,]
####################################################################
fit<-glm(income~age+educationNum+hoursWeek+sex,df,family='binomial')
summary(fit)
############################### 1ST GRAPH ###############################
testedsex<-data.frame(age=rep(40,20),
educationNum=rep(6:15,2),
hoursWeek=rep(45,20),
sex=c(rep(' Male',10),rep(' Female',10)))
testedsex$pred<-predict(fit,newdata=testedsex,type='response')
ggplot(testedsex,aes(x=educationNum,y=pred,color=sex))+geom_line(size=1.2)+
xlab("Years of Education")+ylab("Prob. of income >= 50K")+
ggtitle("Male vs. Female income by Years of education")
############################### 2ND GRAPH ###############################
tested<-data.frame(age=rep(45,22),
educationNum=rep(c(5:15),2),
hoursWeek=c(rep(20,11),rep(70,11)),
sex=rep(' Male',22))
tested$pred<-predict(fit,newdata=tested,type='response')
ggplot(tested,aes(x=educationNum,y=pred,group=hoursWeek,color=hoursWeek))+
geom_line(size=1.2)+xlab("Years of Education")+ylab("Prob. of income >= 50K")+
ggtitle("Income vs. education level")+
geom_hline(yintercept=0.5,color='red',size=1.2)
############################### 3RD GRAPH ###############################
testhours<-data.frame(age=rep(30,7),
educationNum=rep(12,7),
hoursWeek=c(25,30,35,40,45,50,55,60,65),
sex=rep(' Female',7))
testhours$pred<-predict(fit,newdata=testhours,type='response')
ggplot(testhours,aes(x=hoursWeek,y=pred))+geom_line(size=1.2)+
xlab("Hours worked per week")+ylab("Prob. of income >= 50K")+
ggtitle("Income vs. hours per week")
############################### 4TH GRAPH ###############################
fit.marital<-glm(income~age+educationNum+hoursWeek+sex+maritalStatus,df,
family='binomial')
summary(fit.marital)
testsex<-data.frame(age=rep(40,7),
educationNum=rep(13,7),
hoursWeek=rep(50,7),
sex=rep(' Female',7),
maritalStatus=as.character(unique(df$maritalStatus)))
testsex$pred<-predict(fit.marital,newdata=testsex,type='response')
ggplot(testsex,aes(x=maritalStatus,y=pred,fill=maritalStatus))+
geom_bar(data=testsex,width=0.7,stat='identity')+
theme(axis.text.x = element_blank(),axis.ticks = element_blank(),
axis.title.x = element_blank())+ylab("Prob. of income >= 50K")+
ggtitle("Income vs. hours per week")
Please comment on the article here: Data - Ilan Man
