Ernesto Gomez

September 25, 2017

head(turnout)
library(dplyr)
library(ggplot2)
newturnout <- turnout%>%
  group_by(educate)%>%
  summarize(averageincome=mean(income), n=n(), totalinc=sum(income))%>%
  mutate(percent=n/sum(n))

Average Income and Education (Figure 1)

As the figure 1 shows, there seems to be a significant correlation between one’s education and their average income. Respondents with higher education levels are more likely to have higher average incomes than those with less education.

ggplot (newturnout) +
  geom_col(aes(x = educate, y = averageincome), color = "purple")

Distribution of Respondents Income and Age (Figure 2)

Figure 2 shows an interesting relationship between respondents’ age and incomes. We see a concentration of higher incomes amongst those between the ages of 25 & 50, with a steady, but sharp decrease in income as repondent’s age increases. This suggests that as one ages, their expected income is likely to be much less than those who are younger or middle-aged.

ggplot(turnout)+
  geom_col(aes(x = age, y = income))

Maximum Likelihood Estimates & maxLik

library(Zelig)
Loading required package: survival
library(maxLik)
ols.lf2 <- function(param) {
  mu <- param[1]
  theta <- param[-1]
  y <- as.vector(turnout$income)
  x <- cbind(1,turnout$educate, turnout$age)
  sigma <- x%*%theta
  sum(dnorm(y, mu, sigma, log = TRUE))
} 
mle_ols2 <- maxLik(logLik = ols.lf2, start = c(mu = 1, theta1 = 1, theta2 = 1, theta3 = 1), method="BFGS")
summary(mle_ols2)
--------------------------------------------
Maximum Likelihood estimation
BFGS maximization, 150 iterations
Return code 0: successful convergence 
Log-Likelihood: -4843.15 
4  free parameters
Estimates:
       Estimate Std. error t value  Pr(> t)    
mu     3.555011   0.069193  51.378  < 2e-16 ***
theta1 0.362114   0.204550   1.770   0.0767 .  
theta2 0.133349   0.010756  12.398  < 2e-16 ***
theta3 0.017507   0.002852   6.139 8.32e-10 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
--------------------------------------------
mle_ols2 <- maxLik(logLik = ols.lf2, start = c(mu = 1, theta1 = 1, theta2 = 1, theta3 = 1), method="NM")
summary(mle_ols2)
--------------------------------------------
Maximum Likelihood estimation
Nelder-Mead maximization, 269 iterations
Return code 0: successful convergence 
Log-Likelihood: -4866.043 
4  free parameters
Estimates:
        Estimate Std. error t value  Pr(> t)    
mu      3.221451   0.069045  46.657  < 2e-16 ***
theta1 -0.722354   0.123845  -5.833 5.45e-09 ***
theta2  0.187446   0.007655  24.486  < 2e-16 ***
theta3  0.029008   0.002344  12.377  < 2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
--------------------------------------------

Age or Education? MaxLik Results

Using the maxLik package, the variable age from our dataset was been introduced. When run under the BFGS, findings show that age does not impact one’s income as much as education does. The maximum likelihood estimatation indicate that income increases by 0.133 for every level of education, compared to 0.017 for every year increase in age. Using a separate maximisation method, such NM (Nelder-Mead), yields a similar finding though not exactly the same estimations. Estimations are all statistically significant.

Ultimately, we can surmise that although original figures showed that both age and education do impact on income in certain ways, we see that education is a much more significant predictor/indicator of one’s income compared to age.

LS0tCnRpdGxlOiA8c3BhbiBzdHlsZT0iY29sb3I6cHVycGxlIj4iSG9tZXdvcmsgMyAtIG1heExpayAiPC9zcGFuPgpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sKLS0tCiMjI0VybmVzdG8gR29tZXoKIyMjU2VwdGVtYmVyIDI1LCAyMDE3CgpgYGB7cn0KaGVhZCh0dXJub3V0KQpgYGAKCmBgYHtyLCBlY2hvPVRSVUV9CmxpYnJhcnkoZHBseXIpCmxpYnJhcnkoZ2dwbG90MikKbmV3dHVybm91dCA8LSB0dXJub3V0JT4lCiAgZ3JvdXBfYnkoZWR1Y2F0ZSklPiUKICBzdW1tYXJpemUoYXZlcmFnZWluY29tZT1tZWFuKGluY29tZSksIG49bigpLCB0b3RhbGluYz1zdW0oaW5jb21lKSklPiUKICBtdXRhdGUocGVyY2VudD1uL3N1bShuKSkKYGBgCgojIzxzcGFuIHN0eWxlPSJjb2xvcjpwdXJwbGUiPkF2ZXJhZ2UgSW5jb21lIGFuZCBFZHVjYXRpb24gKEZpZ3VyZSAxKTwvc3Bhbj4KQXMgdGhlIGZpZ3VyZSAxIHNob3dzLCB0aGVyZSBzZWVtcyB0byBiZSBhIHNpZ25pZmljYW50IGNvcnJlbGF0aW9uIGJldHdlZW4gb25lJ3MgZWR1Y2F0aW9uIGFuZCB0aGVpciBhdmVyYWdlIGluY29tZS4gUmVzcG9uZGVudHMgd2l0aCBoaWdoZXIgZWR1Y2F0aW9uIGxldmVscyBhcmUgbW9yZSBsaWtlbHkgdG8gaGF2ZSBoaWdoZXIgYXZlcmFnZSBpbmNvbWVzIHRoYW4gdGhvc2Ugd2l0aCBsZXNzIGVkdWNhdGlvbi4gCmBgYHtyfQpnZ3Bsb3QgKG5ld3R1cm5vdXQpICsKICBnZW9tX2NvbChhZXMoeCA9IGVkdWNhdGUsIHkgPSBhdmVyYWdlaW5jb21lKSwgY29sb3IgPSAicHVycGxlIikKYGBgCgoKIyM8c3BhbiBzdHlsZT0iY29sb3I6cHVycGxlIj5EaXN0cmlidXRpb24gb2YgUmVzcG9uZGVudHMgSW5jb21lIGFuZCBBZ2UgKEZpZ3VyZSAyKTwvc3Bhbj4KRmlndXJlIDIgc2hvd3MgYW4gaW50ZXJlc3RpbmcgcmVsYXRpb25zaGlwIGJldHdlZW4gcmVzcG9uZGVudHMnIGFnZSBhbmQgaW5jb21lcy4gV2Ugc2VlIGEgY29uY2VudHJhdGlvbiBvZiBoaWdoZXIgaW5jb21lcyBhbW9uZ3N0IHRob3NlIGJldHdlZW4gdGhlIGFnZXMgb2YgMjUgJiA1MCwgd2l0aCBhIHN0ZWFkeSwgYnV0IHNoYXJwIGRlY3JlYXNlIGluIGluY29tZSBhcyByZXBvbmRlbnQncyBhZ2UgaW5jcmVhc2VzLiBUaGlzIHN1Z2dlc3RzIHRoYXQgYXMgb25lIGFnZXMsIHRoZWlyIGV4cGVjdGVkIGluY29tZSBpcyBsaWtlbHkgdG8gYmUgbXVjaCBsZXNzIHRoYW4gdGhvc2Ugd2hvIGFyZSB5b3VuZ2VyIG9yIG1pZGRsZS1hZ2VkLgoKYGBge3J9CmdncGxvdCh0dXJub3V0KSsKICBnZW9tX2NvbChhZXMoeCA9IGFnZSwgeSA9IGluY29tZSkpCmBgYAoKCiMjPHNwYW4gc3R5bGU9ImNvbG9yOnB1cnBsZSI+TWF4aW11bSBMaWtlbGlob29kIEVzdGltYXRlcyAmIG1heExpazwvc3Bhbj4KYGBge3J9CmxpYnJhcnkoWmVsaWcpCmxpYnJhcnkobWF4TGlrKQpvbHMubGYyIDwtIGZ1bmN0aW9uKHBhcmFtKSB7CiAgbXUgPC0gcGFyYW1bMV0KICB0aGV0YSA8LSBwYXJhbVstMV0KICB5IDwtIGFzLnZlY3Rvcih0dXJub3V0JGluY29tZSkKICB4IDwtIGNiaW5kKDEsdHVybm91dCRlZHVjYXRlLCB0dXJub3V0JGFnZSkKICBzaWdtYSA8LSB4JSoldGhldGEKICBzdW0oZG5vcm0oeSwgbXUsIHNpZ21hLCBsb2cgPSBUUlVFKSkKfSAKYGBgCgoKCmBgYHtyLCBtZXNzYWdlPUZBTFNFLCB3YXJuaW5nPUZBTFNFfQptbGVfb2xzMiA8LSBtYXhMaWsobG9nTGlrID0gb2xzLmxmMiwgc3RhcnQgPSBjKG11ID0gMSwgdGhldGExID0gMSwgdGhldGEyID0gMSwgdGhldGEzID0gMSksIG1ldGhvZD0iQkZHUyIpCgpzdW1tYXJ5KG1sZV9vbHMyKQpgYGAKCgoKYGBge3IsIG1lc3NhZ2U9RkFMU0UsIHdhcm5pbmc9RkFMU0V9Cm1sZV9vbHMyIDwtIG1heExpayhsb2dMaWsgPSBvbHMubGYyLCBzdGFydCA9IGMobXUgPSAxLCB0aGV0YTEgPSAxLCB0aGV0YTIgPSAxLCB0aGV0YTMgPSAxKSwgbWV0aG9kPSJOTSIpCgpzdW1tYXJ5KG1sZV9vbHMyKQpgYGAKCiMjIzxzcGFuIHN0eWxlPSJjb2xvcjpwdXJwbGUiPkFnZSBvciBFZHVjYXRpb24/IE1heExpayBSZXN1bHRzPC9zcGFuPgpVc2luZyB0aGUgbWF4TGlrIHBhY2thZ2UsIHRoZSB2YXJpYWJsZSBhZ2UgZnJvbSBvdXIgZGF0YXNldCB3YXMgYmVlbiBpbnRyb2R1Y2VkLiBXaGVuIHJ1biB1bmRlciB0aGUgQkZHUywgZmluZGluZ3Mgc2hvdyB0aGF0IGFnZSBkb2VzIG5vdCBpbXBhY3Qgb25lJ3MgaW5jb21lIGFzIG11Y2ggYXMgZWR1Y2F0aW9uIGRvZXMuIFRoZSBtYXhpbXVtIGxpa2VsaWhvb2QgZXN0aW1hdGF0aW9uIGluZGljYXRlIHRoYXQgaW5jb21lIGluY3JlYXNlcyBieSAwLjEzMyBmb3IgZXZlcnkgbGV2ZWwgb2YgZWR1Y2F0aW9uLCBjb21wYXJlZCB0byAwLjAxNyBmb3IgZXZlcnkgeWVhciBpbmNyZWFzZSBpbiBhZ2UuIFVzaW5nIGEgc2VwYXJhdGUgbWF4aW1pc2F0aW9uIG1ldGhvZCwgc3VjaCBOTSAoTmVsZGVyLU1lYWQpLCB5aWVsZHMgYSBzaW1pbGFyIGZpbmRpbmcgdGhvdWdoIG5vdCBleGFjdGx5IHRoZSBzYW1lIGVzdGltYXRpb25zLiBFc3RpbWF0aW9ucyBhcmUgYWxsIHN0YXRpc3RpY2FsbHkgc2lnbmlmaWNhbnQuCgpVbHRpbWF0ZWx5LCB3ZSBjYW4gc3VybWlzZSB0aGF0IGFsdGhvdWdoIG9yaWdpbmFsIGZpZ3VyZXMgc2hvd2VkIHRoYXQgYm90aCBhZ2UgYW5kIGVkdWNhdGlvbiBkbyBpbXBhY3Qgb24gaW5jb21lIGluIGNlcnRhaW4gd2F5cywgd2Ugc2VlIHRoYXQgZWR1Y2F0aW9uIGlzIGEgbXVjaCBtb3JlIHNpZ25pZmljYW50IHByZWRpY3Rvci9pbmRpY2F0b3Igb2Ygb25lJ3MgaW5jb21lIGNvbXBhcmVkIHRvIGFnZS4K